home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mplbas.zip / RBBSSUB1.BAS < prev    next >
BASIC Source File  |  1989-09-26  |  72KB  |  2,123 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB1.BAS CPC17.2B, Copyright 1986-89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 07-30-89
  8. '  Copyright ..........: 1986-1989
  9. '  Purpose.............:
  10. '     Subprorams that require error trapping are incorporated
  11. '     within RBBSSUB1.BAS as separately callable subroutines
  12. '     in order to free up as much code as possible within
  13. '     the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  CHANGEDIR  20101   Change subdirectory
  19. '  CHECKINT   58360   Check input is valid integer
  20. '  COMMPUT    59275   Write string to communications port
  21. '  FINDFREE   51098   Find amount of space on the upload disk drive
  22. '  FINDITX    20219   Find if a file exists on a device              ' KG061001
  23. '  FINDUSER   12598   Find a user in the USERS file
  24. '  FLUSHCOM   20308   Read all characters in the communications port
  25. '  GETCOM      1418   Read a character from the communications port
  26. '  GETPASWD   58280   Read RBBS-PC's "PASSWORD" file
  27. '  GETWRK     58330   Read record from file number 2
  28. '  KILLWORK   58258   Delete a RBBS-PC "WORK" file
  29. '  NETBIOS    20898   Lock/Unlock NETBIOS semaphore files
  30. '  OPENCOM      200   Open communications port (number 3)
  31. '  OPENFMS    58188   Open the upload management system directory
  32. '  OPENOUTW   28218   Open RBBS-PC's "WORK" file (number 2) for output
  33. '  OPENRSEQ    1479   Open a sequential file (number 2) for random I/O
  34. '  OPENUSER    9398   Open the USER file (number 5)
  35. '  OPENWORK   57978   Open RBBS-PC's work file (number 2)
  36. '  OPENWRKA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  37. '  PRINTIT    13673   Print line on the local PC printer
  38. '  PRINTWRK   58320   Print string to file #2 w/o CR/LF
  39. '  PRNTWRKA   58350   Print string to file #2 with CR/LF
  40. '  PUTCOM     59650   Write to the communications port
  41. '  PUTWORK    59660   Write to work file randomly
  42. '  RBBSPLAY   59680   Plays a musical string
  43. '  READANY    58310   Read file number 2 into A$
  44. '  READDEF      112   Read configuration file
  45. '  READDIR    58290   Read entire lines
  46. '  READPARMS  58300   Read certain number of parameters from file 2
  47. '  TALK       59700   RBBS-PC Voice synthesizer support for sight impaired
  48. '  SETCALL      108   Find where next callers record is
  49. '  UPDATEC    43048   Update the caller's file with elasped session time
  50. '  UPDTCALR   13661   Update to the caller's file
  51. '
  52. '  $INCLUDE: 'RBBS-VAR.BAS'
  53. '
  54. 108 ' $SUBTITLE: 'SETCALL - subroutine to find last callers rec'
  55. ' $PAGE
  56. '
  57. '  NAME    -- SETCALL
  58. '
  59. '  INPUTS  --     PARAMETER                    MEANING
  60. '
  61. '  OUTPUTS --  CALLERS.FILE.INDEX!
  62. '
  63. '  PURPOSE --  To find where to leave off on callers file
  64. '
  65.     SUB SETCALL STATIC
  66.     ON ERROR GOTO 65000
  67.     IF PREV.CALLERS$ = CALLERS.FILE$ OR CALLERS.FILE.PREFIX$ = "" THEN _
  68.        EXIT SUB
  69.     PREV.CALLERS$ = CALLERS.FILE$
  70.     CALLERS.FILE.INDEX! = 1
  71.     CLOSE 2
  72.     CLOSE 4
  73.     IF SHARE.IT THEN _
  74.        OPEN CALLERS.FILE$ FOR RANDOM SHARED AS #4 LEN=64 _
  75.     ELSE OPEN "R",4,CALLERS.FILE$,64
  76.     FIELD 4,64 AS CALLERS.RECORD$
  77.     IF LOF(4) > 0 THEN _
  78.        CALLERS.FILE.INDEX! = LOF(4) / 64
  79.     IF CALLERS.FILE.INDEX! < 1 THEN _
  80.        CALLERS.FILE.INDEX! = 0
  81.     B$ = STRING$(13,0)
  82. 110 GET 4,CALLERS.FILE.INDEX!
  83.     IF EC > 0 THEN _
  84.        EC = 0 : _
  85.        CALLERS.FILE.INDEX! = 0 : _
  86.        EXIT SUB
  87.     IF LEFT$(CALLERS.RECORD$,13) = B$ THEN _
  88.        CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! - 1 : _
  89.        GOTO 110
  90.     END SUB
  91.  
  92. 112 ' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
  93. ' $PAGE
  94. '
  95. '  NAME    -- READDEF
  96. '
  97. '  INPUTS  --     PARAMETER                    MEANING
  98. '                CONFIG.FILENAME$            NAME OF RBBS-PC.DEF FILE
  99. '                SUBROUTINE.PARAMETER = -62  ONLY READ THE .DEF FILE
  100. '
  101. '  OUTPUTS --  ALL THE RBBS-PC.DEF PARAMETERS
  102. '
  103. '  PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  104. '
  105.      SUB READDEF (CONFIG.FILE$) STATIC
  106.      ON ERROR GOTO 65000
  107. '
  108. ' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ***
  109. '
  110. 117 IF SUBROUTINE.PARAMETER <> -62 THEN _
  111.        IF PREV.READ$ = CONFIG.FILE$ THEN _
  112.           EXIT SUB _
  113.        ELSE PREV.READ$ = CONFIG.FILE$
  114.     CLOSE 2
  115.     BULLETIN.SAVE$ = BULLETIN.MENU$
  116.     CALL OPENWORK (2,CONFIG.FILE$)
  117.     CURRENT.DEF$ = CONFIG.FILE$
  118.     INPUT #2,DF$, _
  119.              DOWNLOAD.DRIVES$, _
  120.              SYSOP.PASSWORD.1$, _
  121.              SYSOP.PASSWORD.2$, _
  122.              SYSOP.FIRST.NAME$, _
  123.              SYSOP.LAST.NAME$, _
  124.              REQUIRED.RINGS, _
  125.              START.OFFICE.HOURS, _
  126.              END.OFFICE.HOURS, _
  127.              MINUTES.PER.SESSION!, _
  128.              DF, _
  129.              DF, _
  130.              UPLOAD.DIRECTORY$, _
  131.              EXPERT.USER.DEF, _
  132.              ACTIVE.BULLETINS, _
  133.              PROMPT.BELL.DEF, _
  134.              DF, _
  135.              MENUS.CAN.PAUSE, _
  136.              MENU$(1), _
  137.              MENU$(2), _
  138.              MENU$(3), _
  139.              MENU$(4), _
  140.              MENU$(5), _
  141.              MENU$(6), _
  142.              CONFERENCE.MENU$, _
  143.              DF, _
  144.              WELCOME.INTERRUPTABLE, _
  145.              REMIND.FILE.TRANSFERS, _
  146.              PAGE.LENGTH.DEF, _                                      ' KG080801
  147.              MAX.MESSAGE.LINES.DEF, _
  148.              DOORS.AVAILABLE, _
  149.              DF$, _
  150.              MAIN.MESSAGE.FILE$, _
  151.              MAIN.MESSAGE.BACKUP$
  152.     INPUT #2, X$, _
  153.               COMMENTS.FILE$, _
  154.               MAIN.USER.FILE$, _
  155.               WELCOME.FILE$, _
  156.               NEWUSER.FILE$, _
  157.               MAIN.DIRECTORY.EXTENTION$
  158.     CALL BRKFNAME (X$,Y$,DF$,Z$,FALSE)
  159.     IF DF$ <> "" THEN _                                              ' RB060403
  160.        CALLERS.FILE$ = X$
  161.     INPUT #2, DF$
  162.     IF COM.PORT$ <> "COM0" THEN _
  163.        IF NOT CONFERENCE.MODE THEN _
  164.           COM.PORT$ = DF$
  165.     INPUT #2, BULLETINS.OPTIONAL, _
  166.               MODEM.INIT.COMMAND$, _
  167.               RTS$, _
  168.               DF, _
  169.               FG, _
  170.               BG, _
  171.               BORDER
  172.     IF CONFERENCE.MODE THEN _
  173.        INPUT #2, DF$, _
  174.                  DF$ _
  175.     ELSE INPUT #2, RBBS.BAT$ , _
  176.                    RCTTY.BAT$
  177.     INPUT #2,OMIT.MAIN.DIRECTORY$, _
  178.              FIRST.NAME.PROMPT$, _
  179.              HELP$(3), _
  180.              HELP$(4), _
  181.              HELP$(7), _
  182.              HELP$(9), _
  183.              BULLETIN.MENU$, _
  184.              BULLETIN.PREFIX$, _
  185.              DF$, _
  186.              MESSAGE.REMINDER, _
  187.              REQUIRE.NON.ASCII, _
  188.              ASK.EXTENDED.DESC, _
  189.              MAXIMUM.NUMBER.OF.NODES, _
  190.              NETWORK.TYPE, _
  191.              RECYCLE.TO.DOS, _
  192.              DF, _
  193.              DF, _
  194.              TRASHCAN.FILE$
  195.     INPUT #2,MINIMUM.LOGON.SECURITY, _
  196.              DEFAULT.SECURITY.LEVEL, _
  197.              SYSOP.SECURITY.LEVEL, _
  198.              FILESEC.FILE$, _
  199.              SYSOP.MENU.SECURITY.LEVEL, _
  200.              CONFMAIL.LIST$, _
  201.              MAXIMUM.VIOLATIONS, _
  202.              OPT.SEC(50), _   ' SECURITY FOR SYSOP COMMANDS 1
  203.              OPT.SEC(51), _
  204.              OPT.SEC(52), _
  205.              OPT.SEC(53), _
  206.              OPT.SEC(54), _
  207.              OPT.SEC(55), _
  208.              OPT.SEC(56), _   ' SYSOP 7
  209.              PASSWORDS.FILE$, _
  210.              MAXIMUM.PASSWORD.CHANGES, _
  211.              MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
  212.              OVERWRITE.SECURITY.LEVEL, _
  213.              DOORS.TERMINAL.TYPE, _
  214.              MAX.PER.DAY
  215.     INPUT #2,OPT.SEC(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  216.              OPT.SEC(2), _
  217.              OPT.SEC(3), _
  218.              OPT.SEC(4), _
  219.              OPT.SEC(5), _
  220.              OPT.SEC(6), _
  221.              OPT.SEC(7), _
  222.              OPT.SEC(8), _
  223.              OPT.SEC(9), _
  224.              OPT.SEC(10), _
  225.              OPT.SEC(11), _
  226.              OPT.SEC(12), _
  227.              OPT.SEC(13), _
  228.              OPT.SEC(14), _
  229.              OPT.SEC(15), _
  230.              OPT.SEC(16), _
  231.              OPT.SEC(17), _
  232.              OPT.SEC(18), _   ' MAIN COMMAND 18
  233.              MIN.NEWCALLER.BAUD, _
  234.              WAIT.BEFORE.DISCONNECT
  235.     INPUT #2,OPT.SEC(19), _      ' Security for FILE COMMANDS 1
  236.              OPT.SEC(20), _
  237.              OPT.SEC(21), _
  238.              OPT.SEC(22), _
  239.              OPT.SEC(23), _
  240.              OPT.SEC(24), _
  241.              OPT.SEC(25), _
  242.              OPT.SEC(26), _      ' FILE COMMAND 8
  243.              OPT.SEC(27), _      ' SECURITY FOR UTILITY COMMANDS 1
  244.              OPT.SEC(28), _
  245.              OPT.SEC(29), _
  246.              OPT.SEC(30), _
  247.              OPT.SEC(31), _
  248.              OPT.SEC(32), _
  249.              OPT.SEC(33), _
  250.              OPT.SEC(34), _
  251.              OPT.SEC(35), _
  252.              OPT.SEC(36), _
  253.              OPT.SEC(37), _
  254.              OPT.SEC(38), _   ' UTIL COMMAND 12
  255.              OPT.SEC(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
  256.              OPT.SEC(47), _
  257.              OPT.SEC(48), _
  258.              OPT.SEC(49), _
  259.              UPLOAD.TIME.FACTOR!, _
  260.              COMPUTER.TYPE, _
  261.              REMIND.PROFILE, _
  262.              RBBS.NAME$, _
  263.              COMMANDS.BETWEEN.RINGS, _
  264.              MNP.SUPPORT, _
  265.              PAGING.PRINTER.SUPPORT$, _
  266.              MODEM.INIT.BAUD$
  267.              IF EC > 0 THEN _
  268.                 EXIT SUB
  269. 118 INPUT #2, TURN.PRINTER.OFF,_    ' Turn printer off each recycle
  270.               DIRECTORY.PATH$, _    ' Where dir files are stored
  271.               MIN.SEC.TO.VIEW, _
  272.               LIMIT.SEARCH.TO.FMS, _
  273.               DEFAULT.CATEGORY.CODE$, _
  274.               DIR.CATEGORY.FILE$, _
  275.               NEW.FILES.CHECK, _
  276.               MAX.DESC.LEN, _
  277.               SHOW.SECTION, _
  278.               COMMANDS.IN.PROMPT, _
  279.               NEWUSER.SETS.DEFAULTS, _
  280.               HELP.PATH$, _
  281.               HELP.EXTENSION$, _
  282.               MAIN.COMMANDS$, _
  283.               FILE.COMMANDS$, _
  284.               UTIL.COMMANDS$, _
  285.               GLOBAL.COMMANDS$, _
  286.               SYSOP.COMMANDS$
  287.     INPUT #2, RECYCLE.WAIT, _
  288.               OPT.SEC(39), _       ' SECURITY FOR LIBRARY COMMANDS 1
  289.               OPT.SEC(40), _
  290.               OPT.SEC(41), _
  291.               OPT.SEC(42), _
  292.               OPT.SEC(43), _
  293.               OPT.SEC(44), _
  294.               OPT.SEC(45), _       ' LIBRARY COMMANDS 7
  295.               LIBRARY.DRIVE$, _
  296.               LIBRARY.DIRECTORY.PATH$, _
  297.               LIBRARY.DIRECTORY.EXTENTION$, _
  298.               LIBRARY.WORK.DISK.PATH$, _
  299.               LIBRARY.MAX.DISK, _
  300.               LIBRARY.MAX.DIRECTORY, _
  301.               LIBRARY.MAX.SUBDIR, _
  302.               LIBRARY.SUBDIR.PREFIX$, _
  303.               LIBRARY.ARCHIVE.PATH$, _
  304.               LIBRARY.ARCHIVE.PROGRAM$, _
  305.               LIBRARY.COMMANDS$
  306. '
  307. ' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ***
  308. ' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ***
  309. '
  310.     INPUT #2, UPLOAD.PATH$, _              ' Where upl dir goes
  311.               MAIN.FMS.DIRECTORY$, _       ' Shared dir in FMS
  312.               ANS.MENU$, _
  313.               REQUIRED.QUESTIONNAIRE$,_
  314.               REMEMBER.NEW.USERS,_
  315.               SURVIVE.NOUSER.ROOM,_
  316.               PROMPT.HASH$,_
  317.               START.HASH,_
  318.               LEN.HASH,_
  319.               PROMPT.INDIV$,_
  320.               START.INDIV,_
  321.               LEN.INDIV
  322.     INPUT #2, BYPASS.MSGS, _
  323.               MUSIC, _
  324.               RESTRICT.BY.DATE, _
  325.               DAYS.TO.WARN, _
  326.               DAYS.IN.REGISTRATION.PERIOD, _
  327.               VOICE.TYPE, _
  328.               RESTRICT.VALID.CMDS, _
  329.               NEW.USER.DEFAULT.MODE, _
  330.               NEW.USER.LINE.FEEDS, _
  331.               ARKVIEW.PATH$, _           'Pe Viewark Mod
  332.               NEW.USER.BELL, _
  333.               NEW.USER.CASE, _
  334.               MESSAGES.CAN.GROW, _
  335.               WRAP.CALLERS.FILE$, _
  336.               REDIRECT.IO.METHOD, _
  337.               AUTO.UPGRADE.SEC, _
  338.               HALT.ON.ERROR, _
  339.               NEW.PUBLIC.MSGS.SECURITY, _
  340.               NEW.PRIVATE.MSGS.SECURITY, _
  341.               SECURITY.NEEDED.TO.CHANGE.MSGS, _
  342.               SL.CATEGORIZE.UPLOADS, _
  343.               BAUDOT, _
  344.               TIME.TO.DROP.TO.DOS, _
  345.               EXPIRED.SECURITY, _
  346.               DTR.DROP.DELAY, _
  347.               ASK.IDENTITY, _
  348.               MAX.REG.SEC, _
  349.               BUFFER.SIZE, _
  350.               MLCOM, _
  351.               SHOOT.YOURSELF, _
  352.               DEFAULT.EXTENSION$, _
  353.               NEW.USER.DEFAULT.PROTOCOL$, _
  354.               NEW.USER.GRAPHICS$, _
  355.               NET.MAIL$, _
  356.               MASTER.DIRECTORY.NAME$, _
  357.               PROTO.DEF$, _
  358.               UPCAT.HELP$, _
  359.               ALWAYS.STREW.TO$, _
  360.               LAST.NAME.PROMPT$
  361. 119 INPUT #2, PERSONAL.DRVPATH$, _
  362.               PERSONAL.DIR$, _
  363.               PERSONAL.BEGIN, _
  364.               PERSONAL.LEN, _
  365.               PERSONAL.PROTOCOL$, _
  366.               PERSONAL.CONCAT , _
  367.               PRIVATE.READ.SEC, _
  368.               PUBLIC.READ.SEC, _
  369.               SEC.CHANGE.MSG, _
  370.               KEEP.INIT.BAUD, _
  371.               MAIN.PUI$
  372.     IF CONFERENCE.MODE THEN _
  373.        INPUT #2, DF$,DF$,DF$ _
  374.     ELSE INPUT #2, DEFAULT.ECHOER$, _
  375.                    HOST.ECHO.ON$, _
  376.                    HOST.ECHO.OFF$
  377.     INPUT #2, SWITCH.BACK, _
  378.               DEFAULT.LINE.ACK$, _
  379.               ALTDIR.EXTENSION$, _
  380.               DIRECTORY.PREFIX$
  381.     IF CONFERENCE.MODE THEN _
  382.        INPUT #2, DF, _
  383.                  DF, _
  384.                  DF _
  385.     ELSE INPUT #2, DF,_
  386.                    MODEM.INIT.WAIT.TIME, _
  387.                    MODEM.COMMAND.DELAY.TIME
  388.     INPUT #2, TURBO.RBBS, _
  389.               SUBDIR.COUNT, _
  390.               DF, _
  391.               UPLOAD.TO.SUBDIR, _
  392.               DF, _
  393.               UPLOAD.SUBDIR$, _
  394.               MIN.OLDCALLER.BAUD, _
  395.               MAX.WORK.VAR, _
  396.               DISKFULL.GO.OFFLINE, _
  397.               EXTENDED.LOGGING
  398.      IF CONFERENCE.MODE THEN _
  399.         INPUT #2, DF$, _
  400.                   DF$, _
  401.                   DF$, _
  402.                   DF$ _
  403.      ELSE INPUT #2, MODEM.RESET.COMMAND$, _
  404.                     MODEM.COUNT.RINGS.COMMAND$, _
  405.                     MODEM.ANSWER.COMMAND$, _
  406.                     MODEM.GO.OFFHOOK.COMMAND$
  407.      INPUT #2,DISK.FOR.DOS$, _
  408.               DUMB.MODEM, _
  409.               COMMENTS.AS.MESSAGES
  410.      IF CONFERENCE.MODE THEN _
  411.         INPUT #2, DF, _
  412.                   DF, _
  413.                   DF, _
  414.                   DF, _
  415.                   DF, _
  416.                   DF _
  417.      ELSE INPUT #2, LSB,_
  418.                     MSB,_
  419.                     LINE.CONTROL.REGISTER,_
  420.                     MODEM.CONTROL.REGISTER,_
  421.                     LINE.STATUS.REGISTER,_
  422.                     MODEM.STATUS.REGISTER
  423.      INPUT #2,KEEP.TIME.CREDITS, _
  424.               XON.XOFF, _
  425.               ALLOW.CALLER.TURBO, _
  426.               USE.DEVICE.DRIVER$, _
  427.               PRELOG$, _
  428.               NEW.USER.QUESTIONNAIRE$, _
  429.               EPILOG$, _
  430.               REGISTRATION.PROGRAM$, _
  431.               QUES.PATH$, _
  432.               USER.LOCATION$, _
  433.               DF$, _
  434.               DF$, _
  435.               DF$, _
  436.               ENFORCE.UPLOAD.DOWNLOAD.RATIOS, _
  437.               SIZE.OF.STACK, _
  438.               SECURITY.EXEMPT.FROM.EPILOG, _
  439.               USE.BASIC.WRITES, _
  440.               DOSANSI, _
  441.               ESCAPE.INSECURE, _
  442.               USE.DIR.ORDER, _
  443.               ADD.DIR.SECURITY, _
  444.               MAX.EXTENDED.LINES, _
  445.               ORIG.COMMANDS$
  446.      INPUT #2,LOGON.MAIL.LEVEL$, _
  447.               MACRO.DRVPATH$, _
  448.               MACRO.EXTENSION$, _
  449.               EMPHASIZE.ON.DEF$, _
  450.               EMPHASIZE.OFF.DEF$, _
  451.               FG.1.DEF$, _
  452.               FG.2.DEF$, _
  453.               FG.3.DEF$, _
  454.               FG.4.DEF$, _
  455.               SECVIO.HLP$
  456.      IF CONFERENCE.MODE THEN _
  457.         INPUT #2,DF _
  458.      ELSE INPUT #2,FOSSIL
  459.      INPUT #2,MAX.CARRIER.WAIT, _
  460.               DF, _
  461.               SMART.TEXT, _
  462.               TIME.LOCK, _
  463.               WRITE.BUF.DEF, _
  464.               SEC.KILL.ANY, _
  465.               DOORS.DEF$, _
  466.               SCREEN.OUT.MSG$, _
  467.               AUTOPAGE.DEF$
  468.      IF EC > 0 THEN _
  469.         EXIT SUB
  470.      CONFIG.FILENAME$ = CONFIG.FILE$
  471.      CALL EDITDEF
  472.      END SUB
  473. 200 ' $SUBTITLE: 'OPENCOM - subroutine to open the communications port'
  474. ' $PAGE
  475. '
  476. '  NAME    -- OPENCOM
  477. '
  478. '  INPUTS  --     PARAMETER                    MEANING
  479. '                BAUD.RATE$                 BAUD TO OPEN MODEM
  480. '                PARITY$                    PARITY TO OPEN MODEM
  481. '
  482. '  OUTPUTS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  483. '
  484. '  PURPOSE -- To open the communications port.
  485. '
  486.     SUB OPENCOM(BAUD.RATE$,PARITY$) STATIC
  487.     ON ERROR GOTO 65000
  488.     IF FOSSIL THEN _
  489.        IF RTS$ = "YES" THEN _
  490.           FLOW.CONTROL = TRUE : _
  491.           FLOW% = &H00F2 : _
  492.           CALL FOSFLOWCTL(COMPORT%,FLOW%)
  493.     IF INSTR(PARITY$,"N") THEN _
  494.        PARITY% = 2 : _                                     ' NO PARITY
  495.        DATABITS% = 3 : _                                   ' 8 DATA BITS
  496.        STOPBITS% = 0 _                                     ' 1 STOP BIT
  497.     ELSE PARITY% = 3 : _                                   ' EVEN PARITY
  498.          DATABITS% = 2 : _                                 ' 7 DATA BITS
  499.          STOPBITS% = 0                                     ' 1 STOP BIT
  500.     IF FOSSIL THEN _
  501.        COMSPEED% = VAL(BAUD.RATE$) : _
  502.        CALL FOSSPEED(COMPORT%,COMSPEED%,PARITY%,DATABITS%,STOPBITS%) : _
  503.        EXIT SUB
  504.     CLOSE 3
  505.     IF RTS$ = "YES" THEN _
  506.        FLOW.CONTROL = TRUE : _
  507.        X$ = ",CS26600,CD,DS" _
  508.     ELSE X$ = ",RS,CD,DS"
  509.     OPEN COM.PORT$ + ":" + BAUD.RATE$ + PARITY$ + X$ AS #3
  510. '
  511. ' ****************************************************************************
  512. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
  513. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
  514. ' ****************************************************************************
  515. '
  516.     END SUB
  517. 1418 ' $SUBTITLE: 'GETCOM -- subroutine reads a char. from  comm. port'
  518. ' $PAGE
  519. '
  520. '  NAME    -- GETCOM
  521. '
  522. '  INPUTS  --   PARAMETER     MEANING
  523. '                 STNG$       STRING TO READ A CHARACTER INTO FROM
  524. '                             THE COMMUNICATIONS PORT (FILE #3)
  525. '
  526. '  OUTPUTS --   STNG$
  527. '
  528. '  PURPOSE -- Reads a character from the communications port.
  529. '
  530.      SUB GETCOM (STRNG$) STATIC
  531.      ON ERROR GOTO 65000
  532. 1420 IF FOSSIL THEN _
  533.         CALL FOSRXCHAR(COMPORT%,CHAR%) : _
  534.         STRNG$ = CHR$(CHAR%) _
  535.      ELSE STRNG$ = INPUT$(1,3)
  536. 1421 IF EC = 57 THEN _
  537.         LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  538.         EC = 0 : _
  539.         GOTO 1420
  540.      END SUB
  541. 1479 ' $SUBTITLE: 'OPENRSEQ  - open sequential file randomly'
  542. ' $PAGE
  543. '
  544. '  NAME    -- OPENRSEQ
  545. '
  546. '  INPUTS  -- PARAMETER             MEANING
  547. '             FILNAME$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  548. '
  549. '  OUTPUTS -- NUM.RECS      NUMBER OF 128-BYTE RECORDS IN THE FILE
  550. '             LEN.LAST.REC  NUMBER OF BYTES IN THE LAST RECORD (IT
  551. '                           MAY BE LESS THAN OR EQUAL TO 128).
  552. '
  553. '  PURPOSE -- Open a sequential file as file #2 and read it randomly
  554. '
  555.      SUB OPENRSEQ (FILNAME$,NUM.RECS,LEN.LAST.REC,REC.LEN) STATIC
  556.      ON ERROR GOTO 65000
  557.      CLOSE 2
  558. 1480 EC = 0
  559. 1481 IF SHARE.IT THEN _
  560.         OPEN FILNAME$ FOR RANDOM SHARED AS #2 LEN=REC.LEN _
  561.      ELSE OPEN "R",2,FILNAME$,REC.LEN
  562.      IF EC = 52 THEN _
  563.         GOTO 1480
  564.      FIELD #2, REC.LEN AS DOWNLOAD.RECORD$
  565.      I# = LOF(2)
  566.      NUM.RECS = FIX(I#/REC.LEN)
  567.      LEN.LAST.REC = I# - CDBL(NUM.RECS) * REC.LEN
  568.      IF LEN.LAST.REC > 0 THEN _
  569.         NUM.RECS = NUM.RECS + 1 _
  570.      ELSE LEN.LAST.REC = REC.LEN
  571.      END SUB
  572. 9398 ' $SUBTITLE: 'OPENUSER - subroutine to open users file as #5'
  573. ' $PAGE
  574. '
  575. '  NAME    -- OPENUSER
  576. '
  577. '  INPUTS  --     PARAMETER                    MEANING
  578. '                 SHARE.IT
  579. '
  580. '  OUTPUTS -- ACTIVE.USER.FILE$
  581. '             CITY.STATE$
  582. '             ELAPSED.TIME$
  583. '             LAST.DATE.TIME.ON$
  584. '             LAST.REC            # OF LAST RECORD IN USERS FILE
  585. '             LIST.NEW.DATE$
  586. '             PASSWORD$
  587. '             SECURITY.LEVEL$
  588. '             USER.DOWNLOADS$
  589. '             USER.NAME$
  590. '             USER.OPTIONS$
  591. '             USER.RECORD$
  592. '             USER.UPLOADS$
  593. '
  594. '  PURPOSE -- Open the user file as file #5
  595. '
  596.       SUB OPENUSER (LAST.REC) STATIC
  597.       ON ERROR GOTO 65000
  598. '
  599. ' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****
  600. '
  601. 9400 CLOSE 5
  602.      IF SHARE.IT THEN _
  603.         OPEN ACTIVE.USER.FILE$ FOR RANDOM SHARED AS #5 LEN=128 _
  604.      ELSE OPEN "R",5,ACTIVE.USER.FILE$,128
  605.      I# = LOF(5)
  606.      LAST.REC = FIX(I#/128)
  607.      FIELD 5,31 AS USER.NAME$, _
  608.              15 AS PASSWORD$, _
  609.               2 AS SECURITY.LEVEL$, _
  610.              14 AS USER.OPTIONS$,  _
  611.              24 AS CITY.STATE$, _
  612.               3 AS MACHINE.TYPE$, _
  613.               4 AS TODAY.DL$, _
  614.               4 AS TODAY.BYTES$, _
  615.               4 AS DL.BYTES$, _
  616.               4 AS UL.BYTES$, _
  617.              14 AS LAST.DATE.TIME.ON$, _
  618.               3 AS LIST.NEW.DATE$, _
  619.               2 AS USER.DOWNLOADS$, _
  620.               2 AS USER.UPLOADS$, _
  621.               2 AS ELAPSED.TIME$
  622.      FIELD 5,128 AS USER.RECORD$
  623.      END SUB
  624. 12598 ' $SUBTITLE: 'FINDUSER - subroutine to search users file for a name'
  625. ' $PAGE
  626. '
  627. '  NAME    -- FINDUSER
  628. '
  629. '  INPUTS  --     PARAMETER                    MEANING
  630. '             HASH.TO.LOOK.FOR$    STRING TO SEARCH FOR IN USERS
  631. '             INDIV.TO.LOOK.FOR$   STRING TO USE TO INDIVIDUATE
  632. '                                  USERS WITH SAME HASH
  633. '             START.HASH.POS       WHERE HASH FIELD STARTS IN THE
  634. '                                  "USERS" FILE
  635. '             LEN.HASH.FIELD       LENGTH OF THE HASH FIELD
  636. '             START.INDIV.POS      WHERE THE FIELD TO DISTINGUISH
  637. '                                  AMONG USERS (I.E. WITH THE SAME
  638. '                                  NAME) STARTS IN THE "USERS" FILE
  639. '                                  (SET TO 0 IF NONE TO BE USED)
  640. '             LEN.INDIV.FIELD      LENGTH OF FIELD TO DISTINGUISH
  641. '                                  AMONG USERS
  642. '             MAX.POSITION         HIGHEST RECORD TO SEARCH OR USE
  643. '
  644. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  645. '
  646. '  OUTPUTS -- WHETHER.FOUND        SET TO "TRUE" IF USER WAS FOUND
  647. '                                  OTHERWISE IT IS "FALSE"
  648. '             POS.TO.USE           NUMBER OF THE "USERS" RECORD THAT
  649. '                                  BELONGS TO THE USER (IF FOUND) OR
  650. '                                  TO USE FOR THE USER (IF THE USER
  651. '                                  WASN'T FOUND)
  652. '             POS.TO.RECLAIM       SET TO 0 IF THE RECORD NUMBER
  653. '                                  SELECTED FOR THIS USER HAS NEVER
  654. '                                  BEEN USED.
  655. '
  656. '  PURPOSE -- To search the "USERS" file and determine the record
  657. '             number to use for the caller in the "USERS" file.
  658. '
  659.       SUB FINDUSER (HASH.TO.LOOK.FOR$,INDIV.TO.LOOK.FOR$,START.HASH.POS,_
  660.                     LEN.HASH.FIELD,START.INDIV.POS,LEN.INDIV.FIELD,_
  661.                     MAX.POSITION,WHETHER.FOUND,_
  662.                     POS.TO.USE,POS.TO.RECLAIM) STATIC
  663.       ON ERROR GOTO 65000
  664.       EC = 0
  665.       WHETHER.FOUND = 0
  666.       IF HASH.TO.LOOK.FOR$ = SPACE$(LEN(HASH.TO.LOOK.FOR$)) THEN _
  667.          EXIT SUB
  668.       EMPTY.REC$ = SPACE$(LEN.HASH.FIELD)
  669.       EMPTY.INDIV$ = SPACE$(LEN.INDIV.FIELD)
  670.       NEWUSER$ = LEFT$("NEWUSER  ",LEN.HASH.FIELD + 2)
  671.       FIELD 5, 128 AS FILLER$
  672.       X$ = HASH.TO.LOOK.FOR$ + SPACE$(LEN.HASH.FIELD - LEN(HASH.TO.LOOK.FOR$))
  673.       CALL HASHRBBS (HASH.TO.LOOK.FOR$,MAX.POSITION,POS.TO.USE,DF)
  674. 12600 Y$ = INDIV.TO.LOOK.FOR$ + SPACE$(LEN.INDIV.FIELD - LEN(INDIV.TO.LOOK.FOR$))
  675.       POS.TO.RECLAIM = 0
  676. 12610 GET 5,POS.TO.USE
  677.       IF EC > 0 THEN _
  678.          IF EC = 63 THEN _
  679.             EC = 0 : _
  680.             GOTO 12621 _
  681.          ELSE EC = 0 : _
  682.          GOTO 12620
  683.       HASH.VALUE$ = MID$(FILLER$,START.HASH.POS,LEN.HASH.FIELD)
  684.       IF X$ = HASH.VALUE$ THEN _
  685.          IF START.INDIV.POS < 1 THEN _
  686.            WHETHER.FOUND = TRUE : _
  687.            GOTO 12622 _
  688.          ELSE INDIV.VALUE$ = MID$(FILLER$,START.INDIV.POS,LEN.INDIV.FIELD) : _
  689.               IF Y$ = INDIV.VALUE$ OR INDIV.VALUE$ = EMPTY.INDIV$ THEN _
  690.                  WHETHER.FOUND = TRUE : _
  691.                  GOTO 12622
  692.       IF HASH.VALUE$ = EMPTY.REC$ THEN _
  693.          POS.TO.USE = POS.TO.RECLAIM - (POS.TO.RECLAIM = 0) * POS.TO.USE : _
  694.          WHETHER.FOUND = FALSE : _
  695.          GOTO 12622
  696.       IF ASC(HASH.VALUE$) = 0 OR INSTR(HASH.VALUE$,NEWUSER$) = 1 THEN _
  697.          IF POS.TO.RECLAIM = 0 THEN _
  698.             POS.TO.RECLAIM = POS.TO.USE
  699. 12620 POS.TO.USE = POS.TO.USE + DF
  700.       IF POS.TO.USE > MAX.POSITION - 1 THEN _
  701.          POS.TO.USE = POS.TO.USE - MAX.POSITION
  702.       GOTO 12610
  703. 12621 IF POS.TO.RECLAIM = 0 THEN _
  704.          POS.TO.RECLAIM = POS.TO.USE
  705.       GOTO 12620
  706. 12622 END SUB
  707. 13661 ' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
  708. ' $PAGE
  709. '
  710. '  NAME    -- UPDTCALR
  711. '
  712. '  INPUTS  --     PARAMETER                    MEANING
  713. '            ERRMES$                   MESSAGE TO GO IN CALLER LOG
  714. '            EXT.LOG              = 1  CHECK FOR EXTENDED LOGGING
  715. '                                      BEFORE UPDATING.
  716. '                                 = 2  UPDATE CALLER LOG WITH Z$
  717. '
  718. '  OUTPUTS -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  719. '             TIM$                    CURRENT TIME (I.E. 1:13 PM)
  720. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  721. '
  722. '  PURPOSE -- To update the caller's file and/or print on the
  723. '             local printer if it is enabled
  724. '
  725.       SUB UPDTCALR (ERRMES$,EXT.LOG) STATIC
  726.       ON ERROR GOTO 65000
  727.       IF CALLERS.FILE.PREFIX$ = "" OR (LOCAL.USER AND SYSOP) THEN _
  728.          EXIT SUB
  729.       X$ = "     " + ERRMES$
  730. 13663 EC = 0
  731.       FIELD 4, 64 AS CALLERS.RECORD$
  732.       IF EC > 0 THEN _
  733.          CALL QTPUT1 ("Caller's file:  error"+STR$(EC)) : _
  734.          EC = 0 : _
  735.          EXIT SUB
  736.       ON EXT.LOG GOTO 13665,13670
  737. '
  738. ' ****  EXTENDED LOGGING ENTRY  ***
  739. '
  740. 13665 IF NOT EXTENDED.LOGGING THEN _
  741.          EXIT SUB
  742.       CALL AMORPM                                                    ' KG061203
  743.       X$ = X$ + " at " + TIM$
  744. '
  745. ' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****
  746. '
  747. 13670 LSET CALLERS.RECORD$ = X$
  748.       CALL PRINTIT (CALLERS.RECORD$)
  749.       IF LOCAL.USER AND PRINTER THEN _
  750.          EXIT SUB
  751.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  752. 13672 PUT 4,CALLERS.FILE.INDEX!
  753.       END SUB
  754. 13673 ' $SUBTITLE: 'PRINTIT - subroutine to print on the local printer'
  755. ' $PAGE
  756. '
  757. '  NAME    -- PRINTIT
  758. '
  759. '  INPUTS  --     PARAMETER                    MEANING
  760. '                 STRNG$             STRING TO WRITE TO THE PRINTER
  761. '
  762. '  OUTPUTS -- NONE
  763. '
  764. '  PURPOSE -- To write to the printer attached to the pc running
  765. '             RBBS-PC and toggle the printer switch off whenever
  766. '             the printer is/becomes unavailable
  767. '
  768.       SUB PRINTIT (STRNG$) STATIC
  769.       ON ERROR GOTO 65000
  770. 13674 IF PRINTER THEN _
  771.          LPRINT STRNG$
  772.       END SUB
  773. 20101 ' $SUBTITLE: 'CHANGEDIR - subroutine to change subdirectories'
  774. ' $PAGE
  775. '
  776. '  NAME    -- CHANGEDIR
  777. '
  778. '  INPUTS  -- PARAMETER                    MEANING
  779. '             DIRECTORY$              NAME OF SUBDIRECTORY
  780. '
  781. '  OUTPUTS -- OK                      TRUE IF CHDIR SUCCESSFUL
  782. '             EC                      ERROR CODE
  783. '
  784. '  PURPOSE -- Change subdirectory
  785. '
  786.       SUB CHANGEDIR (DIRECTORY$) STATIC
  787.       ON ERROR GOTO 65000
  788.       EC = 0
  789.       OK = TRUE
  790. 20103 CHDIR DIRECTORY$
  791.       END SUB
  792. 20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
  793. ' $PAGE
  794. '
  795. '  NAME    -- FINDITX
  796. '
  797. '  INPUTS  -- PARAMETER                    MEANING
  798. '             FILNAME$                NAME OF FILE TO FIND
  799. '             FILNUM                  # TO OPEN FILE AS              ' KG061001
  800. '
  801. '  OUTPUTS -- OK                      TRUE IF FILE EXISTS
  802. '             EC                      ERROR CODE
  803. '
  804. '  PURPOSE -- Determine whether a file exists
  805. '
  806.       SUB FINDITX (FILNAME$,FILNUM) STATIC                           ' KG061001
  807.       ON ERROR GOTO 65000
  808.       EC = 0
  809.       OK = FALSE
  810.       IF LEN(FILNAME$) < 1 THEN _
  811.          EXIT SUB
  812.       IF TURBO.RBBS THEN _
  813.          CALL FINDFILE (FILNAME$,OK) : _
  814.          IF OK THEN _
  815.             GOTO 20222 _
  816.          ELSE EXIT SUB
  817. 20221 CALL BADFILECHAR (FILNAME$,OK)
  818.       IF NOT OK THEN _
  819.          EXIT SUB
  820.       OK = FALSE
  821.       NAME FILNAME$ AS FILNAME$
  822.       IF EC = 53 THEN _
  823.          EXIT SUB
  824. 20222 CLOSE FILNUM                                                   ' KG061001
  825. 20223 CALL OPENWORK (FILNUM,FILNAME$)                                ' KG061001
  826.       IF EC = 64 OR EC = 76 THEN _
  827.          EXIT SUB
  828.       OK = TRUE
  829.       END SUB
  830. 20308 ' $SUBTITLE: 'FLUSHCOM -- subroutine reads all char. from  comm. port'
  831. ' $PAGE
  832. '
  833. '  NAME -- FLUSHCOM
  834. '
  835. '  INPUTS --   PARAMETER     MEANING
  836. '              STNG$       STRING TO READ CHARACTERS INTO FROM
  837. '                          THE COMMUNICATIONS PORT (FILE #3)
  838. '
  839. '  OUTPUTS --   STNG$
  840. '
  841. '  PURPOSE -- Reads all characters from the communications port.
  842. '
  843.       SUB FLUSHCOM (STRNG$) STATIC
  844.       ON ERROR GOTO 65000
  845.       IF LOCAL.USER THEN _
  846.          EXIT SUB
  847.       STRNG$ = ""
  848.       IF NOT FOSSIL THEN _
  849.          GOTO 20311
  850. 20310 CALL FOSREADAHEAD(COMPORT%,CHAR%)
  851.       IF CHAR% <> -1 THEN _
  852.          CALL FOSRXCHAR(COMPORT%,CHAR%) : _
  853.          STRNG$ = STRNG$ + CHR$(CHAR%) : _
  854.          GOTO 20310
  855.       EXIT SUB
  856. 20311 STRNG$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
  857. 20312 IF EC = 57 THEN _
  858.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  859.          EC = 0 : _
  860.          GOTO 20311
  861.       END SUB
  862. 20898 ' $SUBTITLE: 'NETBIOS - subroutine to lock/unlock using NETBIOS'
  863. ' $PAGE
  864. '
  865. '  NAME    -- NETBIOS   (WRITTEN BY DOUG AZZARITO)
  866. '
  867. '  INPUTS  -- IBM.LOCK.CMD       = 1-LOCK, 0-UNLOCK
  868. '             IBM.FILE.LOCK      = 5 USERS FILE
  869. '                                = 6 SEMAPHORE FILE
  870. '             IBM.RECORD.LOCK    = RECORD NUMBER TO LOCK
  871. '
  872. '  OUTPUTS -- NONE
  873. '
  874. '  PURPOSE -- Lock and unlock files using NETBIOS commands.
  875. '             If lock fails, this routine tries forever.
  876. '
  877.       SUB NETBIOS (IBM.LOCK.CMD,IBM.FILE.LOCK,IBM.RECORD.LOCK) STATIC
  878.       STATIC IBMCOUNT
  879.       ON ERROR GOTO 65000
  880. 29900 ON IBM.LOCK.CMD + 1 GOTO 29920, 29910
  881.       EXIT SUB
  882. '
  883. ' *****  LOCK LOOP   ****
  884. '
  885. 29910 EC = 0
  886.       IF IBM.FILE.LOCK = 6 AND IBM.RECORD.LOCK = 3 THEN _
  887.          IBMCOUNT = IBMCOUNT + 1 : _
  888.          IF IBMCOUNT > 1 THEN _
  889.             EXIT SUB
  890.       LOCK IBM.FILE.LOCK, IBM.RECORD.LOCK TO IBM.RECORD.LOCK
  891.       IF EC <> 0 THEN _
  892.          GOTO 29910
  893.       EXIT SUB
  894. 29920 EC = 0
  895.       IF IBM.FILE.LOCK = 6 AND IBM.RECORD.LOCK = 3 THEN _
  896.          IBMCOUNT = IBMCOUNT - 1 : _
  897.          IF IBMCOUNT > 0 THEN _
  898.             EXIT SUB _
  899.          ELSE IBMCOUNT = 0
  900.       UNLOCK IBM.FILE.LOCK, IBM.RECORD.LOCK TO IBM.RECORD.LOCK
  901.       IF EC <> 0 THEN _
  902.          GOTO 29920
  903.       END SUB
  904. 43048 ' $SUBTITLE: 'UPDATEC - update of callers log on exiting'
  905. ' $PAGE
  906. '
  907. '  NAME    -- UPDATEC
  908. '
  909. '  INPUTS  --     PARAMETER                    MEANING
  910. '             CALLERS.FILE.INDEX!
  911. '             FIRST.NAME$
  912. '             HHH
  913. '             LAST.NAME$
  914. '             MMM
  915. '             NG$
  916. '             SSS
  917. '             SYSOP.FIRST.NAME$
  918. '             SYSOP.LAST.NAME$
  919. '
  920. '  OUTPUTS -- CALLERS.RECORD$
  921. '             CALLERS.FILE.INDEX!
  922. '             SYSOP
  923. '
  924. '  PURPOSE -- Update the callers file at logoff so that the number
  925. '             of hours, minutes, and seconds for the session are
  926. '             recorded as the last 9 characters of the 64-character
  927. '             callers file record
  928. '
  929.       SUB UPDATEC STATIC
  930.       ON ERROR GOTO 65000
  931.       IF CALLERS.FILE.PREFIX$ = "" THEN _
  932.          EXIT SUB
  933. '
  934. ' ****  UPDATE CALLERS FILE AT LOGOFF  ***
  935. '
  936. 43050 FIELD 4,55 AS CALLERS.RECORD$,3 AS HOURS$,3 AS MINUTES$,3 AS SECONDS$
  937.       LSET CALLERS.RECORD$ = MID$(NG$,65,55)
  938.       LSET HOURS$ = STR$(HHH)
  939.       LSET MINUTES$ = STR$(MMM)
  940.       LSET SECONDS$ = STR$(SSS)
  941.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  942.       PUT 4,CALLERS.FILE.INDEX!
  943.       FIELD 4,64 AS CALLERS.RECORD$
  944.       LSET CALLERS.RECORD$ = LEFT$(NG$,64)
  945.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  946.       PUT 4,CALLERS.FILE.INDEX!
  947. 43060 LSET CALLERS.RECORD$ = STRING$(64,CHR$(0))
  948.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  949.       PUT 4,CALLERS.FILE.INDEX!
  950.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  951.       PUT 4,CALLERS.FILE.INDEX!
  952.       IF ORIG.CALLERS$ <> CALLERS.FILE$ THEN _
  953.          CALLERS.FILE$ = ORIG.CALLERS$ : _
  954.          CALL SETCALL : _
  955.          GOTO 43050
  956.       END SUB
  957. 51098 ' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
  958. ' $PAGE
  959. '
  960. '  NAME    -- FINDFREE
  961. '
  962. '  INPUTS  --     PARAMETER                    MEANING
  963. '                 Z$                        NAME OF FILE TO FIND
  964. '
  965. '  OUTPUTS -- FREE.SPACE$               NUMBER OF BYTES FREE
  966. '
  967. '  PURPOSE -- To determine amount of free space on a device
  968. '
  969.       SUB FINDFREE STATIC
  970.       ON ERROR GOTO 65000
  971.       EC = 0
  972. 52000 IF TURBO.RBBS THEN _
  973.          GOTO 52003
  974.       FREE.SPACE$ = ""
  975.       CLS
  976.       EC = 0
  977. 52001 FILES Z$
  978.       IF EC = 53 AND (Z$ = COMMENTS.FILE$ OR Z$ = UPLOAD.DRIVE.FILE$ ) THEN _
  979.          CALL OPENOUTW (Z$) : _
  980.          GOTO 52000
  981.       IF EC = 53 AND Z$ = UPLOAD.DIRECTORY$ THEN _
  982.          A$ = "Upload directory missing.  Tell SYSOP" : _
  983.          SUBROUTINE.PARAMETER = 6 : _
  984.          CALL TPUT : _
  985.          GOTO 52002
  986.       FOR X = 1 TO 25
  987.          FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
  988.       NEXT
  989. 52002 SUBROUTINE.PARAMETER = 1
  990.       CALL LINE25
  991.       EXIT SUB
  992. 52003 AX% = 0
  993.       BX% = 0
  994.       CX% = 0
  995.       DX% = 0
  996.       IF MID$(Z$,2,1) = ":" THEN _
  997.          AX% = ASC(Z$) - ASC("A") + 1
  998.       CALL RBBSFREE (AX%,BX%,CX%,DX%)
  999.       I# = CDBL(AX%) * (BX% + 65536! * (-(BX% < 0)))                 ' DA050204
  1000.       I# = I# * CX%
  1001.       FREE.SPACE$ = STR$(I#) + _
  1002.                     " bytes free"
  1003.       END SUB
  1004. 57978 ' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
  1005. ' $PAGE
  1006. '
  1007. '  NAME   -- OPENWORK
  1008. '
  1009. '  INPUTS --     PARAMETER                    MEANING
  1010. '                FILNUM                    # OF FILE TO OPEN AS
  1011. '                FILNAME$                  NAME OF FILE TO FIND
  1012. '                SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1013. '
  1014. '  OUTPUTS -- EC                        ERROR CODE
  1015. '
  1016. '  PURPOSE -- To open RBBS-PC's "work" file (number 2)
  1017. '
  1018.       SUB OPENWORK (FILNUM,FILNAME$) STATIC
  1019.       ON ERROR GOTO 65000
  1020. 58000 CLOSE FILNUM
  1021. 58010 EC = 0
  1022. 58020 IF SHARE.IT THEN _
  1023.          OPEN FILNAME$ FOR INPUT SHARED AS #FILNUM _
  1024.       ELSE OPEN "I",FILNUM,FILNAME$
  1025.       IF EC = 52 THEN _
  1026.          GOTO 58010
  1027. 58030 END SUB
  1028. 58190 ' $SUBTITLE: 'OPENFMS - subroutine to open the FMS directory'
  1029. ' $PAGE
  1030. '
  1031. '  NAME    -- OPENFMS
  1032. '
  1033. '  INPUTS  -- PARAMETER                      MEANING
  1034. '             SHARE.IT                DOS SHARING FLAG
  1035. '             FMS.DIRECTORY$        NAME OF FMS DIRECTORY
  1036. '
  1037. '  OUTPUTS -- LAST.REC                NUMBER OF THE LAST
  1038. '                                     RECORD IN THE FILE
  1039. '
  1040. '  PURPOSE -- To open the upload directory as a random file and find
  1041. '             the number of the last record in the file.
  1042. '
  1043.       SUB OPENFMS (LAST.REC) STATIC
  1044.       ON ERROR GOTO 65000
  1045.       FILE.LENGTH = 38 + MAX.DESC.LEN
  1046.       CLOSE 2
  1047.       IF ACTIVE.FMS.DIRECTORY$ = "" THEN _
  1048.          IF MENU.INDEX = 6 THEN _
  1049.             ACTIVE.FMS.DIRECTORY$ = LIBRARY.DIRECTORY$ _
  1050.          ELSE ACTIVE.FMS.DIRECTORY$ = FMS.DIRECTORY$
  1051.       IF SHARE.IT THEN _
  1052.          OPEN ACTIVE.FMS.DIRECTORY$ FOR RANDOM SHARED AS #2 LEN=FILE.LENGTH _
  1053.       ELSE OPEN "R",2,ACTIVE.FMS.DIRECTORY$,FILE.LENGTH
  1054. '
  1055. ' ** Commented out this code since I think it's not right to crash the
  1056. '   bbs if an error occures
  1057. '
  1058. '      IF EC > 0 THEN _
  1059. '         CALL QTPUT1 ("Drive/path does not exist or bad name for FMS dir " + _
  1060. '                     ACTIVE.FMS.DIRECTORY$) : _
  1061. '         END
  1062. ' code below just exits the subroutine on an error not the whole BBS !!!
  1063. '
  1064.       IF EC > 0 THEN
  1065.       EC = 0 
  1066. CALL QTPUT (CHR$(7)+"Error Has Occured...try again !!!!!  " ,1)
  1067. LAST.REC =0
  1068. EXIT SUB
  1069. END IF
  1070.       LAST.REC = LOF(2)/FILE.LENGTH
  1071.       IF ACTIVE.FMS.DIRECTORY$ = PREV.FMS$ THEN _
  1072.          EXIT SUB
  1073.       PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
  1074.       FIELD 2, FILE.LENGTH AS FMS.REC$
  1075.       GET #2,1
  1076.       A = (LEFT$(FMS.REC$,4) <> "\FMS")
  1077.       UPINC = 2*(INSTR(FMS.REC$," TOP ") = 0 OR A) + 1
  1078.       DATE.ORDERED.FMS = A OR (INSTR(FMS.REC$," NOSORT") = 0)
  1079.       DF = INSTR(FMS.REC$,"CH(")
  1080.       CHAINED.DIR$ = ""
  1081.       IF DF > 0 AND (NOT A) THEN _
  1082.          X = INSTR(DF,FMS.REC$,")") : _
  1083.          IF X > 0 THEN _
  1084.             CHAINED.DIR$ = MID$(FMS.REC$,DF+3,X-DF-3) : _
  1085.             CALL FINDFILE (CHAINED.DIR$,OK) : _
  1086.             IF NOT OK THEN _
  1087.                CHAINED.DIR$ = ""
  1088.       END SUB
  1089. 58220 ' $SUBTITLE: 'OPENOUTW - sub to open output work file (2)'
  1090. ' $PAGE
  1091. '
  1092. '  NAME    -- OPENOUTW
  1093. '
  1094. '  INPUTS  --     PARAMETER                 MEANING
  1095. '                 FILE.NAME$            NAME OF FILE TO FIND
  1096. '                 SHARE.IT              USE DOS' "SHARE" FACILITIES
  1097. '
  1098. '  OUTPUTS -- EC                        ERROR CODE
  1099. '
  1100. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for output
  1101. '
  1102.       SUB OPENOUTW (FILNAME$) STATIC
  1103.       ON ERROR GOTO 65000
  1104.       CLOSE 2
  1105. 58225 EC = 0
  1106. 58230 IF SHARE.IT THEN _
  1107.          OPEN FILNAME$ FOR OUTPUT SHARED AS #2 _
  1108.       ELSE OPEN "O",2,FILNAME$
  1109. 58235 END SUB
  1110. 58260 ' $SUBTITLE: 'KILLWORK - subroutine to delete a "work" file'
  1111. ' $PAGE
  1112. '
  1113. '  NAME    -- KILLWORK
  1114. '
  1115. '  INPUTS  --     PARAMETER                    MEANING
  1116. '                 FILNAME$                  NAME OF FILE TO DELETE
  1117. '
  1118. '  OUTPUTS -- EC                        ERROR CODE
  1119. '
  1120. '  SUBROUTINE PURPOSE -- To delete a RBBS-PC "work" file
  1121. '
  1122.       SUB KILLWORK (FILNAME$) STATIC
  1123.       ON ERROR GOTO 65000
  1124.       CLOSE 2
  1125.       EC = 0
  1126. 58270 KILL FILNAME$
  1127. 58275 END SUB
  1128. 58280 ' $SUBTITLE: 'GETPASWD - sub to read the "passwords" file'
  1129. ' $PAGE
  1130. '
  1131. '  NAME    -- GETPASWD
  1132. '
  1133. '                          PARAMETER             MEANING
  1134. '  INPUTS  -- FILE # 2 OPENED
  1135. '
  1136. '  OUTPUTS -- TEMP.PASSWORD$
  1137. '             TEMP.SECURITY.LEVEL
  1138. '             TEMP.TIME.ALLOWED
  1139. '             TEMP.REG.PERIOD
  1140. '             TEMP.MAX.PER.DAY
  1141. '
  1142. '  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
  1143. '
  1144.       SUB GETPASWD STATIC
  1145.       ON ERROR GOTO 65000
  1146.       EC = 0
  1147.       INPUT #2,TEMP.PASSWORD$,     TEMP.SECURITY.LEVEL, _
  1148.                TEMP.TIME.ALLOWED,  TEMP.MAX.PER.DAY, _
  1149.                TEMP.REG.PERIOD,    START.TIME, _
  1150.                END.TIME,           BYTE.METHOD, _
  1151.                RATIO.RESTRICTION#, INITIAL.CREDIT#, _
  1152.                TEMP.TIME.LOCK
  1153. 58285 END SUB
  1154. 58290 ' $SUBTITLE: 'READDIR - subroutine to read the "DIR" files'
  1155. ' $PAGE
  1156. '
  1157. '  NAME    -- READDIR
  1158. '
  1159. '                          PARAMETER             MEANING
  1160. '  INPUTS  -- FILNUM                  WHICH # FILE TO READ
  1161. '             WHICH.LINE              HOW MANY LINES TO ADVANCE
  1162. '
  1163. '  OUTPUTS -- A$
  1164. '
  1165. '  PURPOSE -- To read possible "DIR" files
  1166. '
  1167.       SUB READDIR (FILNUM,WHICH.LINE) STATIC
  1168.       ON ERROR GOTO 65000
  1169.       EC = 0
  1170.       FOR I = 1 TO WHICH.LINE
  1171.          LINE INPUT #FILNUM,A$
  1172.       NEXT
  1173. 58295 END SUB
  1174. 58300 ' $SUBTITLE: 'READPARMS - subroutine to read parameter values'
  1175. ' $PAGE
  1176. '
  1177. '  NAME    -- READPARMS
  1178. '
  1179. '               PARAMETER             MEANING
  1180. '  INPUTS  -- FILE # 2 OPENED
  1181. '             NUM.PARMS               # parameters to read
  1182. '             WHICH.LINE              Which set of parms to return
  1183. '  OUTPUTS -- ARA.TO.USER$            Array of string values
  1184. '             FILE.SECURITY
  1185. '             FILE.PASSWORD$
  1186. '
  1187. '  PURPOSE -- To read different values, where values are
  1188. '             separated by a comma or carriage-return-line-feed.
  1189. '
  1190.       SUB READPARMS (ARA.TO.USE$(1),NUM.PARMS,WHICH.LINE) STATIC
  1191.       ON ERROR GOTO 65000
  1192.       EC = 0
  1193.       FOR J = 1 TO WHICH.LINE
  1194.          FOR I = 1 TO NUM.PARMS
  1195.             INPUT #2,ARA.TO.USE$(I)
  1196.          NEXT
  1197.       NEXT
  1198. 58305 END SUB
  1199. 58310 ' $SUBTITLE: 'READANY - subroutine to read file 2 into A$'
  1200. ' $PAGE
  1201. '
  1202. '  NAME    -- READANY
  1203. '
  1204. '               PARAMETER             MEANING
  1205. '  INPUTS  -- FILE # 2 OPENED
  1206. '
  1207. '  OUTPUTS -- A$
  1208. '
  1209. '  PURPOSE -- To read file #2 into A$
  1210. '
  1211.       SUB READANY STATIC
  1212.       ON ERROR GOTO 65000
  1213.       EC = 0
  1214.       INPUT #2,A$
  1215. 58315 END SUB
  1216. 58320 ' $SUBTITLE: 'PRINTWRK - subroutine to print to file 2'
  1217. ' $PAGE
  1218. '
  1219. '  NAME    -- PRINTWRK
  1220. '
  1221. '               PARAMETER             MEANING
  1222. '  INPUTS  -- FILE # 2 OPENED
  1223. '             STRING TO WRITE OUT
  1224. '
  1225. '  OUTPUTS -- NONE
  1226. '
  1227. '  PURPOSE -- To print a string to file #2
  1228. '
  1229.       SUB PRINTWRK (STRNG$) STATIC
  1230.       ON ERROR GOTO 65000
  1231.       EC = 0
  1232.       PRINT #2,STRNG$;
  1233. 58325 END SUB
  1234. 58330 ' $SUBTITLE: 'GETWORK - subroutine to read file 2'
  1235. ' $PAGE
  1236. '
  1237. '  NAME    -- GETWORK
  1238. '
  1239. '               PARAMETER             MEANING
  1240. '  INPUTS  -- REC.LEN            Length of record
  1241. '
  1242. '  OUTPUTS -- NONE
  1243. '
  1244. '  PURPOSE -- To read a record from file #2
  1245. '
  1246.       SUB GETWORK (REC.LEN) STATIC
  1247.       ON ERROR GOTO 65000
  1248.       EC = 0
  1249.       FIELD 2, REC.LEN AS DOWNLOAD.RECORD$
  1250.       GET 2,(LOC(2)+1)
  1251. 58335 END SUB
  1252. 58340 ' $SUBTITLE: 'OPENWRKA - subroutine to open output work file (2)'
  1253. ' $PAGE
  1254. '
  1255. '  NAME    -- OPENWRKA
  1256. '
  1257. '  INPUTS  --     PARAMETER                    MEANING
  1258. '              FILNAME$                  NAME OF FILE TO FIND
  1259. '              SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1260. '
  1261. '  OUTPUTS -- EC                        ERROR CODE
  1262. '
  1263. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
  1264. '
  1265.       SUB OPENWRKA (FILNAME$) STATIC
  1266.       ON ERROR GOTO 65000
  1267.       CLOSE 2
  1268.       EC = 0
  1269.       IF SHARE.IT THEN _
  1270.          OPEN FILNAME$ FOR APPEND SHARED AS #2 _
  1271.       ELSE OPEN "A",2,FILNAME$
  1272. 58345 END SUB
  1273. 58350 ' $SUBTITLE: 'PRNTWRKA - subroutine to print to file 2 with CR'
  1274. ' $PAGE
  1275. '
  1276. '  NAME    -- PRNTWRKA
  1277. '
  1278. '                          PARAMETER             MEANING
  1279. '  INPUTS  -- FILE # 2 OPENED
  1280. '                        STRING TO WRITE OUT
  1281. '
  1282. '  OUTPUTS -- NONE
  1283. '
  1284. '  PURPOSE -- To print a string to file #2 followed by a carriage return
  1285. '
  1286.       SUB PRNTWRKA (STRNG$) STATIC
  1287.       ON ERROR GOTO 65000
  1288.       EC = 0
  1289.       PRINT #2,STRNG$
  1290. 58355 END SUB
  1291. 58360 ' $SUBTITLE: 'CHECKINT - subroutine to check input is an integer'
  1292. ' $PAGE
  1293. '
  1294. '  NAME    -- CHECKINT
  1295. '
  1296. '             PARAMETER             MEANING
  1297. '  INPUTS  -- STRNG$         STRING TO VERIFY CAN BE AN INTEGER
  1298. '
  1299. '  OUTPUTS -- EC             = 0 MEANS IT IS AN INTEGER VALUE
  1300. '                           <> 0 MEANS IT IS NOT AN INTEGER VALUE
  1301. '             TESTED.INTEGER.VALUE  Integer value of expression      ' KG083102
  1302. '
  1303. '  PURPOSE -- To validate that a string represents an integer
  1304. '
  1305.       SUB CHECKINT (STRNG$) STATIC
  1306.       ON ERROR GOTO 65000
  1307.       EC = 0
  1308.       X$ = STRNG$                                                    ' KG083102
  1309.       CALL TRIM (X$)                                                 ' KG083102
  1310.       TESTED.INTEGER.VALUE = VAL(LEFT$(X$,INSTR(X$+" "," ")-1))      ' KG083102
  1311. 58365 END SUB
  1312. 59650 ' $SUBTITLE: 'PUTCOM -- subroutine to write to communications port'
  1313. ' $PAGE
  1314. '
  1315. '  NAME    --  PUTCOM
  1316. '
  1317. '  INPUTS  --   PARAMETER     MEANING
  1318. '                STNG$       STRING TO PRINT TO COMM PORT
  1319. '              FLOW.CONTROL  WHETHER USING CLEAR TO SEND FOR FLOW
  1320. '                            CONTROL BETWEEN THE PC AND THE MODEM
  1321. '
  1322. '  OUTPUTS --
  1323. '
  1324. '  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
  1325. '             before writing to the communications port.
  1326. '
  1327.       SUB PUTCOM (STRNG$) STATIC
  1328.       ON ERROR GOTO 65000
  1329.       IF LOCAL.USER THEN _
  1330.          EXIT SUB
  1331.       CALL CHKCARRIER                                                ' KG061203
  1332.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1333.          EXIT SUB
  1334.       IF NOT XOFF.ED THEN _
  1335.          GOTO 59652
  1336.       SUBROUTINE.PARAMETER = 1
  1337.       CALL LINE25
  1338.       Y$ = XOFF$
  1339.       CALL SETABORT (X!,WAIT.BEFORE.DISCONNECT)
  1340.       WHILE Y$ = XOFF$ AND SUBROUTINE.PARAMETER <> -1
  1341.          CHAR% = -1
  1342.          WHILE CHAR% = -1 AND SUBROUTINE.PARAMETER <> -1
  1343.             GOSUB 59654
  1344.          WEND
  1345.          IF CHAR% <> -1 THEN _
  1346.             CALL GETCOM(Y$) : _
  1347.             IF XON.XOFF AND Y$ <> XON$ THEN _
  1348.                Y$ = XOFF$
  1349.       WEND
  1350.       XOFF.ED = FALSE
  1351.       SUBROUTINE.PARAMETER = 1
  1352.       CALL LINE25
  1353. 59652 NOT.CTS = FALSE
  1354.       IF NOT FOSSIL THEN _
  1355.          PRINT #3,STRNG$; : _
  1356.          EXIT SUB
  1357.       IF STRNG$ = "" THEN _
  1358.          EXIT SUB
  1359.       FOR N = 1 TO LEN(STRNG$)
  1360.           CHAR% = ASC(MID$(STRNG$,N,1))
  1361. 59653     CALL FOSTXCHARNW(COMPORT%,CHAR%,RESULT%)
  1362.           IF RESULT% = 0 THEN _
  1363.              GOTO 59653
  1364.       NEXT
  1365.       EXIT SUB
  1366. 59654 CALL EOFCOMM (CHAR%)
  1367.       CALL GOIDLE
  1368.       CALL CHKCARRIER                                                ' KG061203
  1369.       CALL CHKTREMAIN (X!)
  1370.       RETURN
  1371.       END SUB
  1372. 59660 ' $SUBTITLE: 'PUTWORK -- subroutine to write to upload files'
  1373. ' $PAGE
  1374. '
  1375. '  NAME    -- PUTWORK
  1376. '
  1377. '  INPUTS  --   PARAMETER     MEANING
  1378. '                STNG$       STRING TO WRITE TO FILE
  1379. '                REC.NUM     RECORD NUMBER TO WRITE
  1380. '                REC.LEN     LENGTH OF RECORD TO WRITE
  1381. '
  1382. '  OUTPUTS --
  1383. '
  1384. '  PURPOSE -- Writes uploaded file records to work file
  1385. '
  1386.       SUB PUTWORK (STRNG$,REC.NUM,REC.LEN) STATIC
  1387.       ON ERROR GOTO 65000
  1388.       FIELD #2,REC.LEN AS UPLOAD.RECORD$
  1389.       LSET UPLOAD.RECORD$ = STRNG$
  1390.       REC.NUM = REC.NUM + 1
  1391.       PUT #2,REC.NUM
  1392.       END SUB
  1393. '
  1394. ' $SUBTITLE: 'DGSALIAS - Subroutine to Create/Update Alias Info file'
  1395. ' $PAGE
  1396. '
  1397. '  SUBROUTINE NAME    -- DGSALIAS
  1398. '
  1399. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1400. '                         GRN$                        CONFERENCE NAME
  1401. '                         ORIG.USER.NAME$             USERS - LOG ON NAME
  1402. '                         DGS.ALIAS$                  USERS - ALIAS NAME
  1403. '                         DGS.STL$                    NULL FIRST TIME IN
  1404. '                                                     'STILL' IF ALIAS EXISTS
  1405. '                                                     OR REAL NAME
  1406. '                         DGS.FILE.NAME$              CONFERENCE ALIAS FILE
  1407. '
  1408. '  OUTPUT PARAMETERS  --  GRN$ ORIG.USER.NAME$ DGS.ALIAS$ DGS.STL$
  1409. '                         DGS.FILE.NAME$
  1410. '
  1411. '  SUBROUTINE PURPOSE --  TO READ CONFA.DEF AND GET USERS ALIAS OR
  1412. '                         CREATE ONE
  1413. '
  1414.      SUB DGSALIAS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$) STATIC
  1415. '
  1416.      IF DGS.STL$ = "" THEN
  1417.     CONFA.DEF.FLAG = 0
  1418.     CALL BRKFNAME (MAIN.USER.FILE$,DRV$,PREFIX$,EXT$,TRUE)
  1419.     DGS.FILE.NAME$ = DRV$ + GRN$ + "A.DEF"
  1420.     CALL FINDIT (DGS.FILE.NAME$)
  1421.     IF OK THEN
  1422.        CONFA.DEF.FLAG = TRUE
  1423.     END IF
  1424.     IF CONFA.DEF.FLAG = TRUE THEN
  1425.        OPEN "I", 7, DGS.FILE.NAME$
  1426.        DGS.ALIAS$ = ""
  1427.        WHILE DGS.ALIAS$ = "" AND NOT EOF(7)
  1428.           INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$
  1429.           DGS.UNL = LEN(DGS.USER.NAME$)
  1430.           IF DGS.USER.NAME$ = LEFT$(ORIG.USER.NAME$,DGS.UNL) THEN
  1431.          DGS.ALIAS$ = DGS.TEMP.ALIAS$
  1432.           END IF
  1433.        WEND
  1434.        CLOSE 7
  1435.     ELSE
  1436.        DGS.ALIAS$ = "NO CONFA.DEF"
  1437.        EXIT SUB
  1438.     END IF
  1439.      END IF
  1440.      CALL GOODALS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$)
  1441.      END SUB
  1442. '
  1443. '
  1444. ' $SUBTITLE: 'GOODALS - Subroutine to Make Sure Alias Good'
  1445. ' $PAGE
  1446. '
  1447. '  SUBROUTINE NAME    -- GOODALS
  1448. '
  1449. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1450. '                         GRN$                        CONFERENCE NAME
  1451. '                         ORIG.USER.NAME$             USERS - LOG ON NAME
  1452. '                         DGS.ALIAS$                  USERS - ALIAS NAME
  1453. '                         DGS.STL$                    NULL FIRST TIME IN
  1454. '                                                     'STILL' IF ALIAS EXISTS
  1455. '                                                     OR REAL NAME
  1456. '                         DGS.FILE.NAME$              CONFERENCE ALIAS FILE
  1457. '
  1458. '  OUTPUT PARAMETERS  --  GRN$ ORIG.USER.NAME$ DGS.ALIAS$ DGS.STL$
  1459. '                         DGS.FILE.NAME$
  1460. '
  1461. '  SUBROUTINE PURPOSE --  TO READ CONFA.DEF AND SEE IF GET USERS ALIAS IS
  1462. '                         ALREADY IN USE OR A REAL NAME
  1463. '
  1464.      SUB GOODALS (GRN$,ORIG.USER.NAME$,DGS.ALIAS$,DGS.STL$,DGS.FILE.NAME$) STATIC
  1465. '
  1466.      IF DGS.ALIAS$ = "" THEN
  1467.     DGS.SFN.SLN$ = SYSOP.FIRST.NAME$+" "+SYSOP.LAST.NAME$
  1468.     A$ = "Do you" +DGS.STL$+ " want to use an Alias? (Y,[N])"
  1469.     SUBROUTINE.PARAMETER = 1
  1470.     CALL TGET
  1471.     IF YES THEN
  1472.        ABFLG$ = ""
  1473.        A$ = "Enter Alias (31 Char. Max.) "
  1474.        SUBROUTINE.PARAMETER = 1
  1475.        CALL TGET
  1476.        CALL ALLCAPS (B$)
  1477.        IF B$ = "" OR INSTR(SPACE$(31),B$) > 0 THEN
  1478.           B$ = ""
  1479.           ABFLG$ = "Alias Must NOT be Blank"
  1480.        END IF
  1481.        IF LEN(B$) > 31 THEN
  1482.           B$= ""
  1483.           ABFLG$ = "Length Must NOT Exceed 31 Characters"
  1484.        END IF
  1485.        IF B$ = "SYSOP" OR B$ = DGS.SFN.SLN$ THEN
  1486.           A$ = CHR$(7)+CHR$(7)
  1487.           A$ = A$ + "Wrong Answer! Alias Request Denied!"
  1488.           A$ = A$ + CHR$(13) + "Contact Sysop for Alias Retry"
  1489.           CALL QTPUT (A$,2)
  1490.           DGS.ALIAS$ = ORIG.USER.NAME$+CHR$(250)
  1491.           ACTIVE.USER.NAME$ = ORIG.USER.NAME$+CHR$(250)
  1492.           FIRST.NAME$ = ORIG.USER.NAME$+CHR$(250)
  1493.        ELSE
  1494.           OPEN "I", 7, DGS.FILE.NAME$
  1495.           WHILE ABFLG$ = "" AND NOT EOF(7)
  1496.          INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$
  1497.          IF B$ = DGS.USER.NAME$ THEN
  1498.             ABFLG$ = " is a Real User"
  1499.          ELSE
  1500.             IF B$ = DGS.TEMP.ALIAS$ THEN
  1501.                ABFLG$ = " has Already been Used"
  1502.             END IF
  1503.          END IF
  1504.           WEND
  1505.           CLOSE 7
  1506.           IF ABFLG$="" THEN
  1507.          DGS.ALIAS$ = B$
  1508.          ACTIVE.USER.NAME$ = B$
  1509.          FIRST.NAME$ = B$
  1510.           ELSE
  1511.          A$="Sorry "+FIRST.NAME$+" but "+B$+ABFLG$
  1512.          CALL QTPUT (A$,1)
  1513.          DGS.STL$ = " still"
  1514.          DGS.ALIAS$ = ""
  1515.           END IF
  1516.        END IF
  1517.     ELSE
  1518.        DGS.ALIAS$ = ORIG.USER.NAME$
  1519.     END IF
  1520.     IF DGS.ALIAS$ <> "" THEN
  1521.        CLOSE 2
  1522.        OPEN "A", 2, DGS.FILE.NAME$
  1523.        WRITE #2, ORIG.USER.NAME$, DGS.ALIAS$
  1524.        CLOSE 2
  1525.     END IF
  1526.      ELSE
  1527.     ACTIVE.USER.NAME$ = DGS.ALIAS$
  1528.     FIRST.NAME$ = DGS.ALIAS$
  1529.      END IF
  1530.  END SUB
  1531. '
  1532. '
  1533. '********************************************************************
  1534. '  THREAD1            First message thread routine                  *
  1535. '  THREAD2            Second message thread routine                 *
  1536. '  THREAD3            Third message thread routine                  *
  1537. '********************************************************************
  1538. '===========================================================================
  1539. 59670 ' $SUBTITLE: 'THREAD1 - create/update threaded message file'
  1540. ' $PAGE
  1541. '
  1542. '  SUBROUTINE NAME    -- THREAD1
  1543. '
  1544. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  1545. '                           HIGH.MESSAGE.NUMBER    This reply's message number
  1546. '                           CURRENT.MESSAGE        Message number being replied
  1547. '
  1548. '  OUTPUT PARAMETERS  --     <<NONE>>
  1549. '
  1550. '  SUBROUTINE PURPOSE -- SUBROUTINE TO...
  1551. '
  1552.       SUB THREAD1 (HIGH.MESSAGE.NUMBER,CURRENT.MESSAGE,GRN$) STATIC
  1553. CALL BRKFNAME (MAIN.MESSAGE.FILE$,DRV$,PREFIX$,EXT$,TRUE) 'Pe 08/02/89
  1554.         IF INSTR(GRN$," ") = 0 THEN   'PE102587
  1555.          FILE.NAME$ = DRV$ +GRN$ + "T"  'PE08/02/89
  1556.         ELSE
  1557.            FILE.NAME$ = DRV$ +LEFT$(GRN$,INSTR(GRN$," ")-1)+"T" 'PE 08/02/89
  1558.       END IF
  1559.       CURRENT.MESSAGE$ = STR$(CURRENT.MESSAGE)
  1560.       HIGH.MESSAGE.NUMBER$ = STR$(HIGH.MESSAGE.NUMBER)
  1561.       OPEN "R",9,FILE.NAME$,12
  1562.       FIELD 9, 6 AS CM$, 6 AS HMN$
  1563.       LSET CM$ = CURRENT.MESSAGE$
  1564.       LSET HMN$ = HIGH.MESSAGE.NUMBER$
  1565.       PUT #9,INT(LOF(9)/12)+1
  1566.       CLOSE (9)
  1567.  END SUB       ' THREAD1
  1568. '
  1569. 59671 ' $SUBTITLE: 'THREAD2 - a message was killed - check threaded message file'
  1570. ' $PAGE
  1571. '
  1572. '  SUBROUTINE NAME    -- THREAD2
  1573. '
  1574. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  1575. '                           MESSAGE.TO.KILL        Killed message's number
  1576. '
  1577. '  OUTPUT PARAMETERS  --     <<NONE>>
  1578. '
  1579. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
  1580. '
  1581.       SUB THREAD2 (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) STATIC
  1582. CALL BRKFNAME (MAIN.MESSAGE.FILE$,DRV$,PREFIX$,EXT$,TRUE) 'Pe 08/02/89
  1583.       IF INSTR(GRN$," ") = 0 THEN     'PE102587
  1584.         FILE.NAME$ = DRV$ +GRN$ + "T"   'Pe 08/02/89
  1585.       ELSE
  1586.         FILE.NAME$ = DRV$+LEFT$(GRN$,INSTR(GRN$," ")-1)+"T" 'Pe 08/02/89
  1587.       END IF
  1588.       OPEN "R",9,FILE.NAME$,12
  1589.       FIELD 9, 6 AS CM$, 6 AS HMN$
  1590.        FOR I = 1 TO INT(LOF(9)/12)
  1591.           GET 9,I
  1592.           IF VAL(CM$) = MESSAGE.TO.KILL THEN     ' MARK THE RECORD
  1593.              LSET CM$ = LEFT$(CM$,5) + "K"
  1594.              PUT 9,I
  1595.           ELSE 
  1596.            IF VAL(HMN$) = MESSAGE.TO.KILL THEN     ' MARK THE RECORD
  1597.               LSET HMN$ = LEFT$(HMN$,5) + "K"
  1598.               LSET CM$ = LEFT$(CM$,5) + "K"
  1599.              PUT 9,I
  1600.           END IF
  1601.        END IF
  1602.       NEXT I
  1603.       CLOSE (9)
  1604.  END SUB      ' THREAD2
  1605. '
  1606. 59672 ' $SUBTITLE: 'THREAD3 - a message was killed - check threaded message file'
  1607. ' $PAGE
  1608. '
  1609. '  SUBROUTINE NAME    -- THREAD3
  1610. '
  1611. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  1612. '                           CURRENT.MESSAGE        Message's number
  1613. '
  1614. '  OUTPUT PARAMETERS  --     <<NONE>>
  1615. '
  1616. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
  1617. '
  1618.       SUB THREAD3 (CURRENT.MESSAGE,GRN$) STATIC
  1619. IF JUST.SEARCHING THEN _            'PE 01/16/89
  1620.  EXIT SUB                           'PE 01/16/89
  1621. CALL BRKFNAME (MAIN.MESSAGE.FILE$,DRV$,PREFIX$,EXT$,TRUE) 'Pe 08/02/89
  1622.       IF INSTR(GRN$," ") = 0 THEN
  1623.          FILE.NAME$ = DRV$ +GRN$ + "T"   'pe 08/02/89
  1624.        ELSE
  1625.          FILE.NAME$ = DRV$ + LEFT$(GRN$,INSTR(GRN$," ")-1)+"T" 'Pe 08/02/89
  1626.       END IF
  1627.        OPEN "R",9,FILE.NAME$,12 
  1628.        FIELD 9, 6 AS CM$, 6 AS HMN$
  1629.       AA$ = ""
  1630.       ZZ$ = ""
  1631.       FOR I = 1 TO INT(LOF(9)/12)
  1632.           GET 9,I
  1633.          IF RIGHT$(HMN$,1) = "K" THEN 59673
  1634.          IF VAL(CM$) = CURRENT.MESSAGE AND RIGHT$(HMN$,1) <> "K" THEN 
  1635.                 AA$ = AA$ + HMN$
  1636.          END IF 
  1637.           IF VAL(HMN$) = CURRENT.MESSAGE AND RIGHT$(CM$,1) = "K" THEN
  1638.                 ZZ$ = LEFT$(CM$,5) + CX$(1)+"(deleted) "+EMPHASIZE.OFF$
  1639.          END IF
  1640.           IF VAL(HMN$) = CURRENT.MESSAGE AND RIGHT$(CM$,1) <> "K" THEN 
  1641.                 ZZ$ = CM$
  1642.          END IF
  1643. 59673 NEXT I
  1644.       IF LEN(AA$) > 0 THEN 
  1645. CALL QTPUT(FG.3$+"   Reply(ies) in message number(s): "+CX$(4) + AA$+EMPHASIZE.OFF$,1)
  1646.       END IF
  1647.       IF LEN(ZZ$) > 0 THEN 
  1648. CALL QTPUT (FG.4$+"   This message is in reply to message " +FG.1$+ ZZ$+EMPHASIZE.OFF$,1)
  1649.       END IF
  1650. CALL QTPUT (CX$(1)+ "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+EMPHASIZE.OFF$,1)
  1651.       CLOSE (9)
  1652.  END SUB      ' THREAD3
  1653. '
  1654. 59674 ' $SUBTITLE: 'THREAD4 - UPDATE CONFR.DEF FILE FOR MESSAGE RECOVERY'
  1655. ' $PAGE
  1656. '
  1657. '  SUBROUTINE NAME    -- THREAD4
  1658. '
  1659. '  INPUT PARAMETERS   --    PARAMETER            MEANING
  1660. '
  1661. '                           MESSAGE.TO.RECOVER   MESSAGE NUMBER BEING RECOVERED
  1662. '                           FIRST.MESSAGE.RECORD NOT USED HERE BUT PASSED IN
  1663. '                                                FROM RBBS CALL TO SUB2
  1664. '                           ACTION.FLAG          PASSED FROM SUB2 NEEDED TO
  1665. '                                                GIVE BACK TO RBBS MAIN CODE
  1666. '                           GRN$                 CONFERENCE NAME
  1667. '
  1668. '  OUTPUT PARAMETERS  --      <<NONE>>
  1669. '
  1670. '  SUBROUTINE PURPOSE -- SUBROUTINE - UPDATE CONFR.DEF FILE AFTER MSG RECVRY
  1671. '
  1672.       SUB THREAD4 (MESSAGE.TO.RECOVER,FIRST.MESSAGES.RECORD,ACTION.FLAG,GRN$) STATIC
  1673. CALL BRKFNAME (MAIN.MESSAGE.FILE$,DRV$,PREFIX$,EXT$,TRUE) 'Pe 08/02/89
  1674.       IF INSTR(GRN$," ") = 0 THEN
  1675.          FILE.NAME$ = DRV$ + GRN$ + "T"   'Pe 08/02/89
  1676.       ELSE
  1677.          FILE.NAME$ = DRV$ + LEFT$(GRN$,INSTR(GRN$," ")-1)+"T"  'Pe 08/02/89
  1678.       END IF
  1679.       OPEN "R",9,FILE.NAME$,12               'WILL CREATE FILE IF NOT EXIST
  1680.       FIELD 9, 6 AS CM$, 6 AS HMN$
  1681.       FOR I = 1 TO INT(LOF(9)/12)
  1682.           GET 9,I
  1683.           IF VAL(CM$) = MESSAGE.TO.RECOVER THEN
  1684.              LSET CM$ = LEFT$(CM$,5) + " "
  1685.              PUT 9,I
  1686.           ELSE
  1687.               IF VAL(HMN$) = MESSAGE.TO.RECOVER THEN
  1688.                  LSET HMN$ = LEFT$(HMN$,5) + " "
  1689.                  LSET CM$ = LEFT$(CM$,5) + " "
  1690.                  PUT 9,I
  1691.               END IF
  1692.           END IF
  1693.       NEXT I
  1694.       CLOSE (9)
  1695. END SUB    'THREAD4
  1696. 59680 ' $SUBTITLE: 'RBBSPLAY -- subroutine to play music'
  1697. ' $PAGE
  1698. '
  1699. '  NAME    -- RBBSPLAY
  1700. '
  1701. '  INPUTS  --   PARAMETER     MEANING
  1702. '                          STRNG$      STRING TO PLAY
  1703. '
  1704. '  OUTPUTS --
  1705. '
  1706. '  PURPOSE -- Play music.  Skip if get an error.
  1707. '
  1708.       SUB RBBSPLAY (STRNG.TO.PLAY$) STATIC
  1709.       PLAY STRNG.TO.PLAY$
  1710.       EC = 0
  1711.       END SUB
  1712. '59700 ' $SUBTITLE: 'TALK -- subroutine for voice response'
  1713. ' $PAGE
  1714. '
  1715. '  NAME    -- TALK
  1716. '
  1717. '  INPUTS  --   PARAMETER     MEANING
  1718. '               VOICE.TYPE    TYPE OF VOICE SYNTHESIZER
  1719. '               VOICE.RECORD  RECORD NUMBER TO RETRIEVE
  1720. '
  1721. '  OUTPUTS --
  1722. '
  1723. '  PURPOSE -- Retrieve voice record and send to voice synthesizer
  1724. '
  1725. '      SUB TALK (VOICE.RECORD,STRNG.WRK$) STATIC
  1726. '      IF VOICE.TYPE = 0 THEN _
  1727. '         EXIT SUB
  1728. '      IF VOICE.RECORD > 0 THEN _
  1729. '         GOTO 59720
  1730. '      CLOSE 7,8
  1731. '      IF VOICE.TYPE = 1 THEN _
  1732. '         OPEN "COM2:2400,E,7,1,CS65535" AS #7 : _
  1733. '         LPRINT "OPENED COM PORT"
  1734. '      IF SHARE.IT THEN _
  1735. '         OPEN "RBBSTALK.DEF" FOR RANDOM SHARED AS #8 LEN=32 _
  1736. '      ELSE OPEN "R",8,"RBBSTALK.DEF",32
  1737. '      FIELD 8,30 AS TALK.RECORD$,2 AS DUMMY$
  1738. '      EXIT SUB
  1739. '59720 IF NOT SNOOP THEN _
  1740. '         EXIT SUB
  1741. '      IF VOICE.RECORD < 65 THEN _
  1742. '         GET 8,VOICE.RECORD : _
  1743. '         STRNG.WRK$ = TALK.RECORD$ : _
  1744. '         CALL TRIM (STRNG.WRK$)
  1745. '59721 IF SMART.TEXT THEN _
  1746. '         CALL SMARTTXT (STRNG.WRK$, CR.FOUND,FALSE)                  ' CS062802
  1747. '59722 IF VOICE.TYPE = 1 THEN _
  1748. '         PRINT #7,STRNG.WRK$
  1749. '59723 IF VOICE.TYPE = 2 THEN _
  1750. '         CALL RBBSHS (CHR$(LEN(STRNG.WRK$)+1)+STRNG.WRK$+CHR$(13))
  1751. '      END SUB
  1752. 59725 ' $SUBTITLE: 'COMMPUT -- Writes to communications port'
  1753. ' $PAGE
  1754. '
  1755. '  NAME    -- COMMPUT
  1756. '
  1757. '  INPUTS  --   PARAMETER     MEANING
  1758. '               STRNG$        String to write
  1759. '               FOSSIL        Whether using Fossil driver
  1760. '
  1761. '  OUTPUTS --
  1762. '
  1763. '  PURPOSE -- Send string to comm port.  Recovers from errors.
  1764. '
  1765.       SUB COMMPUT (STRNG$) STATIC
  1766.       ON ERROR GOTO 65000
  1767.       IF FOSSIL THEN _
  1768.          STRNG$ = STRNG$ + CARRIAGE.RETURN$ : _
  1769.          BYTES% = LEN(STRNG$) : _
  1770.          CALL FOSWRITE(COMPORT%,BYTES%,STRNG$) _
  1771.       ELSE PRINT #3,STRNG$
  1772.       END SUB
  1773. '
  1774. ' $SUBTITLE: 'VIEWTXT - Subroutine to display ASCII file from ARC file'
  1775. ' $PAGE
  1776. '
  1777.   SUB VIEWTXT STATIC
  1778.   ON ERROR GOTO 65000
  1779. '
  1780. 60140 SUBROUTINE.PARAMETER = 1 
  1781. A$ ="T)ype, X)tract, C)ompress, D)ir, H)elp or [Quit]" +CRLF$
  1782. A$ = CRLF$ + A$ + "Enter Choice T,X,C,D,?,H,[Q] "
  1783.         TURBO.KEY = -TURBO.KEY.USER
  1784.         CALL TGET
  1785. IF SUBROUTINE.PARAMETER = -1 THEN_   
  1786.    EXIT SUB
  1787. IF Q = 0 THEN _
  1788.  EXIT SUB          'Pe 05/24/89                    
  1789.         CALL ALLCAPS (B$)
  1790.         X = INSTR("TXCD?HQ",B$)
  1791.      ON X GOTO 60149,60168,60175,60142,60141,60141,60180
  1792. GOTO 60180
  1793. '
  1794. 60141 CALL BUFFILE (HELP.PATH$ + "ZIP" + HELP.EXTENSION$,X)  'Pe 03/26/89
  1795.       GOTO 60140                                             'Pe 03/26/89
  1796. 60142  CALL QTPUT ("Creating file list, one moment please....",1)
  1797.    EXTRACT$ = "DIR "+ ARKVIEW.PATH$+">VUZIP"+NODE.ID$+".LST"
  1798.    SHELL EXTRACT$
  1799. CALL BUFFILE("VUZIP"+NODE.ID$ +".LST",X)
  1800. GOTO 60140
  1801. '
  1802. 60149 SUBROUTINE.PARAMETER = 1
  1803.      A$ = "What file(s) to Type, R)elist or [ENTER] to quit"         'DMOD1
  1804.      CALL TGET
  1805. IF SUBROUTINE.PARAMETER = -1 THEN _
  1806.  EXIT SUB                              'Pe 05/24/89
  1807.        B = 1                                                            'DMOD1
  1808.        IF Q = 0 THEN _                                                  'DMOD1
  1809.         GOTO 60140              'Pe 05/24/89 was Exit Sub
  1810. IF B$ = "R" or B$ = "r" THEN _
  1811.    CALL BUFFILE (ARC.WORK$,X) : _
  1812. GOTO 60149
  1813.        LAST.ARC = Q                                                     'DMOD1
  1814.        FIRST.ARC = B                                                    'DMOD1
  1815. '
  1816. FOR ARC.INDEX = FIRST.ARC TO LAST.ARC                            'DMOD1
  1817.    Z$ = B$(ARC.INDEX)                                                'DMOD1
  1818.    CALL ALLCAPS (Z$)  
  1819.   IF INSTR(Z$,"*") OR INSTR(Z$,"?") THEN _
  1820.     CALL QTPUT ("Sorry Widcars NOT allowed !!",1) : _
  1821.      GOTO 60149                                           'PEMOD1
  1822.  CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)                        'DMOD1
  1823.  IF EXT$ = "ARC" OR EXT$ = "COM" OR EXT$ = "EXE" OR EXT$ = "BAS" OR _   'DMOD1
  1824.          EXT$ = "BIN" OR EXT$ = "LIB" OR EXT$ = "OBJ" OR EXT$ = "PIC" THEN _ 
  1825.          CALL QTPUT ("Sorry, only ASCII files can be viewed",1) :_      'DMOD1
  1826.          GOTO 60149                                                     'DMOD1
  1827.       CALL QTPUT ("Please stand by while I extract that file....",1)    'DMOD1
  1828. '
  1829. '
  1830. ' ******* Next 3 lines added for ZIP support    Pe 02/19/89
  1831. IF LAST.EXT$ = "ZIP" THEN _
  1832.  SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKUNZIP -O " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ : _
  1833. GOTO 60150 _
  1834. ELSE IF LAST.EXT$ = "LZH" THEN _
  1835.  SHOWME$ = LIBRARY.ARCHIVE.PATH$+"VIEWLZH.BAT "+ARKVIEW.PATH$+" "+FILE.NAME$+" "+Z$ : _
  1836.   GOTO 60150
  1837. '
  1838.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="PK" THEN _
  1839.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKXARC -R " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$
  1840.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="AR" THEN _
  1841.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"ARCE " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ + " /R"
  1842.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,3) ="PAK" THEN _
  1843.  SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PAK /E/WA " + FILE.NAME$ + " "+ ARKVIEW.PATH$+Z$
  1844. 60150 SHOWME$ = "COMMAND.COM /C "+SHOWME$   'Pe 09/20/89
  1845.       SHELL SHOWME$                                         'Pe 02/19/89
  1846.       Z$ = ARKVIEW.PATH$ + Z$      'Pe 09/23/89
  1847.       TEMP$ = Z$
  1848.       CALL BUFFILE (Z$,X)                                             'DMOD1
  1849.         IF NOT OK THEN _
  1850.          CALL QTPUT(CHR$(7)+Z$+"NOT found or bad Spelling",1) :_
  1851.         GOTO 60149
  1852.       CALL KILLWORK(TEMP$)   'get rid of the files that were xtracted   PEMOD1
  1853.        NEXT ARC.INDEX
  1854. GOTO 60140
  1855. '
  1856. 60168 SUBROUTINE.PARAMETER = 1
  1857.       CALL SKIPLINE (1)
  1858. 60169  A$ = "What file(s) to Extract, R)elist or [ENTER] quits"
  1859.     CALL TGET
  1860. IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 11/29/88
  1861.    EXIT SUB                              'Pe 11/29/88
  1862. IF B$ = "R" or B$ = "r" THEN _
  1863.    CALL BUFFILE (ARC.WORK$,X) : _
  1864.    GOTO 60168
  1865.       B = 1                                                            'DMOD1
  1866.       IF Q = 0 THEN _                                                  'DMOD1
  1867.        EXIT SUB                                                        'DMOD1
  1868.        LAST.ARC = Q                                                    'DMOD1
  1869.        FIRST.ARC = B                                                   'DMOD1
  1870.  FOR ARC.INDEX = FIRST.ARC TO LAST.ARC                           'DMOD1
  1871.   Z$ = B$(ARC.INDEX)                                                   'DMOD1
  1872.      CALL ALLCAPS (Z$)
  1873.      CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)                        'DMOD1
  1874.      CALL SKIPLINE (2)
  1875.      CALL QTPUT ("Please stand by while I extract the file(s)....",1)    'DMOD1
  1876. '
  1877. 'Next 3 lines for ZIP Support Pe 02/19/89
  1878. '
  1879. IF LAST.EXT$ = "ZIP" THEN _
  1880.  SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKUNZIP -O " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$ : _
  1881. GOTO 60170 _
  1882. ELSE IF LAST.EXT$ = "LZH" THEN _
  1883.  SHOWME$ = LIBRARY.ARCHIVE.PATH$+ "VIEWLZH.BAT "+ARKVIEW.PATH$+" "+FILE.NAME$+" "+Z$ : _
  1884.  GOTO 60170
  1885.  
  1886. '
  1887. '
  1888.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="PK" THEN _
  1889.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PKXARC -R " + FILE.NAME$ + " " + Z$ + " " + ARKVIEW.PATH$
  1890.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,2) ="AR" THEN _
  1891.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"ARCE " + FILE.NAME$ + " " + Z$ + " " + ARKVIEW.PATH$+" /R"
  1892.  IF MID$(LIBRARY.ARCHIVE.PROGRAM$,1,3) ="PAK" THEN _
  1893.       SHOWME$ = LIBRARY.ARCHIVE.PATH$+"PAK /E/WA " + FILE.NAME$ + " " + ARKVIEW.PATH$ + "\" +Z$
  1894. '
  1895. 60170 SHOWME$ = "COMMAND.COM /C "+ SHOWME$
  1896.  SHELL SHOWME$     'Added line Number Pe 02/19/89
  1897. LOOKFOR$ = ARKVIEW.PATH$ + Z$  'Pe 09/23/89
  1898. CALL FINDIT(LOOKFOR$)
  1899.      IF NOT OK THEN _
  1900. CALL QTPUT ("Error extracting " + Z$ + "...file Skipped...",2) : _
  1901.       GOTo 60171
  1902.        CALL QTPUT (Z$+" Is now  Extracted ...",2)
  1903. 60171 NEXT ARC.INDEX
  1904. CALL QTPUT ("Use the C)ompress command to create a ZIP file of Xtracted files",2)
  1905. GOTO 60140
  1906. '
  1907. ' ***  Added choice of Compressing file or taking it as is Pe 03/23/89 ***
  1908. '
  1909. 60175 Subroutine.parameter = 1          'Pe 03/26/89
  1910.       A$ = CRLF$ +"List files about to be Compressed (Y/[N])"
  1911.     CALL TGET
  1912. IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 03/29/88
  1913.    EXIT SUB                              'Pe 03/29/88
  1914. IF B$ ="N" or B$ = "n" Then _            'Pe 04/07/89
  1915.    GOTO 60179                            'pe 04/07/89
  1916. IF B$ = "Y" or B$ = "y" THEN _           'Pe 03/29/89
  1917.  CALL QTPUT ("Creating file list, one moment please....",1): _
  1918.    EXTRACT$ = "DIR "+ ARKVIEW.PATH$+">VUZIP"+NODE.ID$+".LST" : _
  1919.    SHELL EXTRACT$ : _
  1920. CALL BUFFILE("VUZIP"+NODE.ID$ +".LST",X) : _
  1921. Subroutine.parameter = 1 : _         'Pe 03/26/89
  1922.  A$ = CRLF$ +"Continue with file Compression ([Y]/N) " : _
  1923.     CALL TGET : _
  1924. IF SUBROUTINE.PARAMETER = -1 THEN _      'Pe 03/29/88
  1925.    EXIT SUB                               'Pe 03/29/88
  1926. IF B$ = "N" or B$ = "n" THEN _           'Pe 03/29/89
  1927.  GOTO 60140
  1928.  CALL QTPUT ("One Moment while I Compress the file(s) for you........",1)
  1929. '
  1930. '********** ARC all files in the ARKVIEW.PATH$ into VIEW.ZIP **********
  1931. '
  1932. '60179  ZIPME$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -m -ex -z<C:\C3\MPL.CMT " + ARKVIEW.PATH$ + "\VIEW.ZIP " + ARKVIEW.PATH$ + "\*.*"
  1933. 60179  ZIPME$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -m -ex " + ARKVIEW.PATH$ + "\VIEW.ZIP " + ARKVIEW.PATH$ + "\*.*"
  1934. SHELL ZIPME$                   
  1935. '
  1936. ' **** Check to see if Compresion was successfull if NOT then redo *****
  1937. VIEW.FILE.NAME$ = ARKVIEW.PATH$ + "VIEW.ZIP"   'Pe 09/23/89 removed \VIEW
  1938. CALL FINDIT (VIEW.FILE.NAME$)
  1939. IF NOT OK THEN _
  1940. CALL QTPUT ( "No files to Compress...you must use the X)tract command first" ,2) : _
  1941. CALL DELAYIT (2) : _
  1942. GOTO 60140
  1943. '
  1944. '
  1945. '********** Tells the caller the name of the file to download **********
  1946. '
  1947. CALL QTPUT (" File has been Compressed and named... VIEW.ZIP....",2)
  1948. CALL QTPUT (CHR$(7)+"To Download this file You MUST enter VIEW.ZIP as the file name",2)
  1949. CALL DELAYIT (3)
  1950. GOTO 60140
  1951. 60180 END SUB
  1952. '
  1953. '
  1954. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  1955. '  $PAGE
  1956. '
  1957. '
  1958. ' Error handling for the separately compiled subroutines of RBBS-PC
  1959. ' 
  1960. '
  1961. 65000 IF DEBUG THEN _
  1962.          A$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  1963.               STR$(ERL) + _
  1964.               " ERR=" + _
  1965.               STR$(ERR) : _
  1966.          IF PRINTER THEN _
  1967.             CALL PRINTIT(A$) _
  1968.          ELSE CALL LPRNT(A$,1)
  1969.       EC = ERR
  1970. '
  1971. '     SETCALL
  1972. '
  1973.       IF ERL = 110 THEN _
  1974.           RESUME NEXT
  1975. '
  1976. '     OPEN CONFIG FILE
  1977. '
  1978.        IF ERL => 117 AND ERL <= 119 THEN _
  1979.           RESUME NEXT
  1980. '
  1981. '     OPEN COM PORT ERROR HANDLING
  1982. '
  1983.       IF ERL = 200 THEN _
  1984.          CLS : _
  1985.          CALL PSCRN (COM.PORT$ + " does not exist/not responding- Error" + STR$(ERR)) : _
  1986.          STOP
  1987. '
  1988. '     GETCOM ERROR HANDLING
  1989. '
  1990.        IF ERL = 1420 AND ERR = 57 THEN _
  1991.           RESUME NEXT
  1992.        IF ERL = 1420 AND ERR = 69 THEN _
  1993.           SUBROUTINE.PARAMETER = -1 :_
  1994.           RESUME NEXT
  1995. '
  1996. '      OPENRESEQ ERROR HANDLING
  1997. '
  1998.        IF ERL = 1481 THEN _
  1999.            EC = ERR : _
  2000.            RESUME NEXT
  2001. '
  2002. '      OPENUSER ERROR HANDLING
  2003. '
  2004.        IF ERL = 9400 AND ERR = 75 AND SHARE.IT THEN _
  2005.           CALL DELAYIT (30) : _
  2006.           RESUME
  2007. '
  2008. '      FINDUSER ERROR HANDLING
  2009. '
  2010.        IF ERL = 12610 THEN _
  2011.           RESUME NEXT
  2012. '
  2013. '     UPDTCALR ERROR HANDLING
  2014. '
  2015.        IF ERL = 13663 THEN _
  2016.           RESUME NEXT
  2017.        IF ERL = 13672 AND ERR = 61 THEN _
  2018.           CALL QTPUT1 ("Disk Full") : _
  2019.           IF DISKFULL.GO.OFFLINE THEN _
  2020.              GOTO 65010 _
  2021.           ELSE RESUME NEXT
  2022.        IF ERL = 13672 THEN _
  2023.           CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! - 1 : _
  2024.           RESUME NEXT
  2025. '
  2026. '     PRINTER ERROR HANDLING
  2027. '
  2028.        IF ERL = 13674 THEN _
  2029.           PRINTER = FALSE : _
  2030.           RESUME
  2031. '
  2032. '      CHANGEDIR ERROR HANDLING
  2033. '
  2034.        IF ERL = 20103 THEN _
  2035.           OK = FALSE : _
  2036.           RESUME NEXT
  2037. '
  2038. '     FINDIT ERROR HANDLING
  2039. '
  2040.        IF ERL = 20221 THEN _
  2041.           RESUME NEXT
  2042.        IF ERL = 20223 AND EC = 58 THEN _
  2043.           EC = 64 : _
  2044.           OK = FALSE : _
  2045.           RESUME NEXT
  2046.        IF ERL = 20223 AND EC = 76 THEN _
  2047.           CALL LPRNT("Bad path.  File name is " + FILNAME$,1) : _
  2048.           EC = 76 : _
  2049.           OK = FALSE : _
  2050.           RESUME NEXT
  2051.        IF ERL => 20221 AND ERL <= 20223 AND EC = 70 _
  2052.           AND NETWORK.TYPE = 6 THEN _
  2053.              EC = 0 : _
  2054.              RESUME NEXT
  2055.        IF ERL => 20221 AND ERL <= 20223 THEN _
  2056.           RESUME
  2057. '
  2058. '     FLUSHCOM ERROR HANDLING
  2059. '
  2060.        IF ERL = 20311 AND ERR = 57 THEN _
  2061.           RESUME NEXT
  2062.        IF ERL = 20311 AND ERR = 69 THEN _
  2063.           ABORT = TRUE : _
  2064.           SUBROUTINE.PARAMETER = -1 : _
  2065.           RESUME NEXT
  2066. '
  2067. '     NETBIOS ERROR HANDLING
  2068. '
  2069.        IF ERL => 29900 AND ERL <= 29920 THEN _
  2070.           RESUME NEXT
  2071. '
  2072. '     UPDATEC ERROR HANDLING
  2073. '
  2074.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  2075.          A$ = "* Disk full - terminating *" : _
  2076.          SUBROUTINE.PARAMETER =2 : _
  2077.          CALL TPUT : _
  2078.          IF DISKFULL.GO.OFFLINE THEN _
  2079.            GOTO 65010 _
  2080.          ELSE SYSTEM
  2081. '
  2082. '     CHECKINT ERROR HANDLING
  2083. '
  2084.        IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
  2085.           NOT.CTS = TRUE : _
  2086.           CALL LINE25 : _
  2087.           EC = 0 : _
  2088.           RESUME
  2089.        IF ERL => 52000 AND ERL <= 59725 THEN _
  2090.           RESUME NEXT
  2091. '      VIEW ARC TXT ERROR HANDLER
  2092. '
  2093.  IF ERL = 60149 AND ERR = 53 THEN _
  2094.          CALL QTPUT ("ERROR !!! No Such File, EXITING",1):_
  2095.          RESUME NEXT
  2096. IF ERL = 60149 AND ERR = 63 THEN _
  2097.          CALL QTPUT ("ERROR Occured, Please notify SysOp",1):_
  2098.          RESUME NEXT
  2099. '
  2100. '
  2101. '      DLVIEW ARC TXT ERROR HANDLER 
  2102. '
  2103.  IF ERL = 60170 AND ERR = 53 THEN _
  2104.          CALL QTPUT ("ERROR !!! No Such File, EXITING",1):_
  2105.          RESUME NEXT
  2106. '
  2107. '
  2108. '     CATCH ALL OTHER ERRORS
  2109. '
  2110.        A$ = "RBBS-SUB1 Untrapped Error" + _
  2111.             STR$(ERR) + _
  2112.             " in line" + _
  2113.             STR$(ERL)
  2114.        CALL QTPUT1 (A$)
  2115.        CALL UPDTCALR (A$,2)
  2116.        RESUME NEXT
  2117. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  2118. 65010  CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  2119.        CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  2120.        IF FOSSIL THEN _
  2121.           CALL FOSEXIT(COMPORT%)
  2122.        SYSTEM
  2123.